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PREFACE 


This  report  was  prepared  by  the  Lockheed-Georg ia  Company,  Marietta, 
Georgia,  for  the  Air  Force  Aero  Propulsion  Laboratory,  Wright-Patterson 
Air  Force  Base  under  Contract  F3361 5-76-C-2021  (Project  3066,  Task  1A). 
The  report  covers  work  done  in  the  period  1 December  1975  through 
1 September  1978.  The  work  described  herein  is  part  of  the  Air  Force 
Aero  Propulsion  Laboratory's  program  to  define  and  control  the  noise 
emission  of  aircraft  propulsion  systems,  and  forms  a continuation  of 
the  studies  conducted  at  Lockheed  under  two  previous  contracts 
(F3361 5-71 -C-1 663  and  F3 3 6 1 5-73-C-2032) , which  were  reported  in  tech- 
nical reports  AFAPL-TR-72-53  (six  volumes)  and  AFAPL-TR-76-65  (four 
volumes),  respectively. 

Mr.  Paul  Shahady  was  the  Air  Force  Aero  Propulsion  Laboratory's 
Project  Engineer  for  the  first  two  contracts,  and  he  also  initiated  the 
third  (i.e.  the  present)  contract.  Lt.  Robert  McGregor  was  the  AFAPL's 
Program  Manager  for  the  present  contract.  Lockheed's  Program  Manager 
for  all  three  contracts  was  Dr.  Harry  E.  Plumblee,  Jr. 

This  Volume  II  - appendix  volume  - presents  a complete  listing  of 
two  computer  programs.  The  first  program,  called  UNI  JET,  is  developed 
to  predict  the  total  noise  from  a subsonic  or  supersonic  jet  under 
static  conditions  using  the  results  of  the  present  contract  together 
with  the  knowledge  gained  in  the  two  previous  contracts.  The  second 
computer  program,  called  INTEG,  is  designed  to  predict  absolute  values 
of  turbulent  mixing  noise  at  90°  to  the  jet  axis,  based  on  laser 
velocimeter  turbulence  measurements.  A detailed  description  of  these 
two  programs  in  the  form  of  a User's  Guide  is  given  in  the  main  volume 
of  this  report. 

The  authors  gratefully  acknowledge  the  efforts  of  Mr.  Robert  H. 
Burrin  in  preparing  this  report  and  Mrs.  Barbara  C.  Reagan  in  typing 
the  manuscript. 

This  report  was  submitted  by  the  authors  on  15  September  1978. 
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•DECK  UNIMAIN 

PROGRAM  UNIMAIN (INPUT. OUTPUT, TAPE5«INPUT»TAPC6»0UTPUTiTAPE2>  A 10 

••••»•••••••••••••••••••••••••••••••••••••»•••••••••••••••••••••  A 20 

• • A 30 

• UNIFIED  JET  NOISE  PREDICTION  PROGRAM  • A AO 

• ....... ........................  • A SO 

• • A 60 

• PACKAGE  A ■ NOISE  FROM  LARGE-SCALE  TURBULENCE  STRUCTURE  • A TO 

• PACKAGE  B ■ TURBULENT  MIXING  NOISE  • A 80 

• PACKAGE  C ■ SHOCK  ASSOCIATED  NOISE  • A 90 

• • A 100 

• OPNO  ■ OPTION  NUMBER  • A 110 

• • A 120 

• OPNO  1 ■ A * A 130 

• OPNO  2 ■ 8 • A 1 AO 

• OPNO  3 ■ C • A ISO 

• OPNO  A • A)  Bi  AND  A»B  • A 160 

• OPNO  5 ■ B,  C*  AND  B*C  • A 170 

• OPNO  6 » A,  C»  AND  A*C  • A 180 

• OPNO  7 ■ A,  B.  C,  AND  A.0.C  • A 190 

• • A 200 

• BOPNO  1 ■ HIGH-FREQUENCY  LILLEY  EQUATION  SOLUTION  • A 21b 

• BOPNO  2 ■ NUMERIC  LILLEY  EQUATION  SOLUTION  • A 220 

• • A 230 

•••••••••••••••••••••••••••••••••••••••••••••••••••••••••A******  A 2a0 

A 250 

DIMENSION  TM(20) .FREO(30)  A 260 

DIMENSION  SPLA(30).SPLB(30).SPLC(30).SPLT(30>  A 270 

DIMENSION  SPLLS(30,20)  A 280 

DIMENSION  SPLM(33,12>  A 290 

DIMENSION  THDOCT (33)  A 300 

A 310 
A 320 

INTEGER  TP. OPNO. BOPNO  A 330 

INTEGER  OPPER  A 340 

REAL  MJ  A 350 

A 360 

INTEGER  OC  A 370 

REAL  K0.K1.L0.L1.MC  A 380 

A 390 

DATA  IC.OC/2H1C.2H  / A 400 

A 410 

DATA  NU  /I / A 420 

A 430 

DATA  THOOCT  / A 440 

1 SO.  . 63.  » 80.  • 100.  . 125.  . 160.  • 200.  . A 450 

2 250.  • 31S.  • 400.  . 500.  . 630.  • 800.  • 1000.  * A 460 

3 1250.  • 1600.  . 2000.  • 2500.  • 3150.  • 4000.  » 5000.  • A 470 

4 6300.  • 8000.  . 10000.  • 12500.  . I6O0O.  • 20000.  • 25000.  • A 480 

5 31500.  • 40000.  • 50000.  . 63000.  • 80000.  / A 490 

WRITE  EXPLANATIONS  FO»  FAILURES  A 500 

A 510 

CALL  DATE  (OATED)  a 5205 

CALL  time  (TIMED)  A 5305 

WRITE  (6.640)  DATED. TIMED  A 540* 

C A 550 

WRITE  (6.650)  A 560* 

C A 5T0 

WRITE  (6.660)  A SBC* 


c 

A 590 

c 

NOVEMBER  15  77.  PREDICTION  FOR  VJ/AO  GT  1 INSIDE  CONE  Of 

A 600 

c 

SILENCE (IC)  allowed 

A 610 

c 

A 620 

WRITE  (6,670) 

A 630* 

c 

A 640 

c 

NOVEMBER  15  77.  PREDICTION  FOR  VJ/AO  GT  1 INSIDE  CONE  OF 

A 650 

c 

SILENCE (IC)  ALLOWED 

A 660 

c 

A 670 

WRITE  (6,680) 

A 680* 

c 

A 690 

c 

READ  STATEMENTS 

A 700 

c 

A 710 

READ  (5.690)  DlA.R 

A 720* 

DFT-OIA/12,0 

A 730 

ROO*R/OFT 

A 740 

c 

A 750 

c 

NFREQ  ■ 0 INPUT  STARTING  1/3  O.B.  NUMBER  IN  ISTART  AND 

A 760 

c 

ending  1/3  o.b.  numbe«  in  istop 

A 770 

c 

NO  FREQUENCIES  ARE  READ  1*|  , 

A 780 

c 

NFREQ  NE  0 NFREQ  IS  THE  NUMBER  OF  FREQUENCIES  TO  BE  READ  IN 

A 790 

c 

ISTART  AND  ISTOP  ARE  NOT  USED, 

A 800 

c 

A 810 

REAO  (5.700)  NANG. NFREQ, ISTART, ISTOP 

A 820* 

c 

A 830 

IF  (NFREQ. EQ.O)  GO  TO  10 

A 840 

READ  (5,690)  (FREQ ( I ), I«1 .NFREQ) 

A 850* 

GO  TO  30 

A 860 

c 

A 870 

10 

NFREQ«(ISTOP-ISTARt>  *1 

A 880 

J-ISTART-1 

A 890 

DO  20  I«1 .NFREQ 

A 900 

J"J*1 

A 910 

20 

FREQ ( I ) "THDOCT ( J) 

A 920 

30 

CONTINUE 

A 930 

c 

A 940 

REAO  (5,690)  < TM ( J) , J»1 .NANG) 

A 950* 

c 

A 960 

c 

A 970 

READ  (5,700)  NS 

A 980* 

READ  (5,690)  C.KO.kI.BC 

A 990* 

c 

A1000 

c 

READ  JET  OPERATING  CONDITIONS  AND  CALCULATE  ALL  BASIC  PARAMETERS 

A1010 

c 

• 

• 

A1020 

c 

• OPPER  0 « FLOW  PARAMETERS  INPUT  ARt  PO.TOF.VJAO.TJTO 

• 

A1030 

c 

• OPPER  1 ■ FLOW  PARAMETERS  INPUT  ARE  PO.TOF.PRG.TRF 

« 

A 1 040 

c 

• 

• 

A1050 

c 

A1060 

READ  (5,700)  OPNO. OPPER, ICODE , IFLG.BOPNO, ISS. IOPT, ILWR 

A1070* 

IF  (0PN0.EQ.2.0R.0PN0.EQ.4.0R.0PN0.EQ.S.0R.0PN0.EQ.7)  CALL  SELECT 

A1080S 

1 (NU, ISS) 

A1090 

40 

READ  (5,700)  TP 

A 1 1 00* 

c 

All  10 

c 

A1120 

IF  (TP, EQ.O)  GO  TO  630 

A 1 1 30 

c 

A1140 

IF  (OPPER.EQ.l)  GO  TO  50 

A1  ISO 

READ  (5,690)  PO.TOF.VJAO.TJTO 

A1160* 

GO  TO  60 

A1170 

SO  READ  (5*690)  PO.TOFtPRG.TRF 
60  CONTINUE 

IP  (I0PT.E0.2)  REA6  (5*600)  RSW 
IF  (I0PT.E0.3)  READ  (5*690)  RSW.ALTB.BLTB 


I COMP* 1 

IF  (ICOOE.EQ.O)  00  TO  100 
IF  (IC00E.E0.2)  00  TO  90 
REAO  (5*700)  I VEL » I ANG » I NC ANG 
ICOMP-O 

IF  (IVEL.EQ.O.OR.lsTART.EO.O.OR.OPPER.EQ.O)  IC0MP*1 

IF  (ICOMP.EO.l)  GO  TO  100 

REWIND  2 

00  80  IV*1»IVEL 

00  70  J-1.12 

REAO  (2,710)  (SPLM(I.J) *1*7*30) 

70  CONTINUE 
60  CONTINUE 

IOFF-ISTART-1 
00  TO  100 


90  I0FF*ISTART-1 
ICOMP*0 
IANG*1 
INCANG-1 

READ  (5,710)  ( (SPLM(1*J) *1*7*30) *J*1*NANG) 


100  CONTINUE 


CLEAR  MAIN  ARRAY  OF  SPLS  FROM  LARGE  SCALE  NOISE  PREDICTION 


00  110  J*1 *20 
DO  110  1*1*30 
110  SPLLS(I,J)*1.0 


CALL  calper  (VJAO,TJTO,PO.TOF,TRF,PRG.TRK,TRTO.PRPO,PRGA,DJOO.MJ,A 
10«VJ,OAMA,OPPER) 


IF  (MJ.LE.1.0)  GO  TO  120 


BETA-SORT <MJ*MJ-1,0) 

LO*KO*OIA*BETA 

L1»K1*DIA*BETA 

MC*C*VJAO 

VC*C*VJ 


WRITE  JET  OPERATING  CONDITIONS  AND  ALL  BASIC  PARAMETERS 


120  WRITE  (6.720)  TP.OPNO,PRG,PO,TRF.TOF,OAMA 


WRITE  (6*730)  PRP0,TRT0,TJT0»DJD0*VJA0»MJ,VJ 


WRITE  (6*7A0)  OIA,R,ROO 


IF  (I0PT.GT.1)  WRITE  (6,750)  RSW 

IF  (I0PT.EQ.3)  WRITE  (6,760)  ALTB.BLTB 

IF  (0PN0.E0.3)  GO  TO  130 

IF  (0PN0.EQ.5)  GO  TO  130 


1 X ISO* 

11190 

11200* 

11210* 

11220 

11230 

11240 

11250 

11260 

11270* 

11260 

11290 

11300 

11310* 

11320 

11330 

11340* 

11350 

11360 

11370 

11380 

11390 

11400 

11410 

11420 

11430 

11440* 

11450 

11460 

11470 

11480 

11490 

11500 

11510 

11520 

11530 

11540S 

11550 

11560 

11570 

11580 

U590 

11600 

11610 

11620 

11630 

11640 

11650 

11660 

11670* 

11680 

11690* 

11700 

11710* 

11720 

11730* 

11740* 

11750 

11760 


I 
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If  (GrNO.EQ.6)  60  TO  130  A1770 

IF  (0PN0.EQ.7)  60  TO  130  A1780 

60  TO  140  A 1790 

C A1800 

130  WRITE  (6*770)  C,K0,K1,NS  A1810* 

C A1820 

IE  (HJ.LE.1.0)  60  TO  140  A1830 

C A1840 

WRITE  (6*780)  BETA.VC.MC.LO.Ll  A1850* 

C A1860 

140  CONTINUE  A1870 

A1880 

BEGIN  AN6LE  LOOP  A1890 

A1900 

JJ»IANG-INCANG  A 1910 

00  620  J*1 *NAN6  A1920 

ZM-TM(J)/57, 2957795  A1930 

JJ* J J* INC ANG  A1940 

A 1950 

COMPUTE  PACKAGE  A IF  OPTION  NUMBER  IS  1*  4*  6*  OR  7 A1960 

A1970 

IF  (0PN0.EQ.1)  60  TO  150  A19B0 

IF  (0PN0.E0.4)  60  TO  150  A1990 

IF  (0PN0.EQ.6)  60  TO  150  A2000 

IF  (OPNO.EQ.7)  60  TO  ISO  A2010 

60  TO  220  A2020 

A2030 

150  CONTINUE  A2040 

A2050 

PACKAGE  A ..  NOISE  FROM  LARGE-SCALE  TURBULENCE  STRUCTURE*****  A2060 

A2070 

IF  (ICOMP.EO.l)  GO  TO  160  A2080 

WRITE  (6.790)  TM(J)  A2090* 

60  TO  170  A2100 

160  WRITE  (6*800)  TMU)  A2U0* 

A2120 

BEGIN  FREOUENCY  LOOP  (PACKAGE  A)  A2130 

A2140 

170  SUMDIF*0.0  A2150 

I H* I OFF  A2160 

NF*0  A2170 

A2180 

DO  210  1*1 *NFREQ  A2190 

A2200 

IF  (J.NE.l)  60  TO  180  A2210 

F*FREQ(I)  A2220 

A2230 
A2240 

STRNO*F*OFT/VJ  A2250 

CALL  LSMAIN  (VJAO.TJTO,OAMA,OFT.VJ,F,I.NANG.TM,IFLG,SPLLS)  A2260S 

180  SPLA ( 1 ) "SPLLS ( I » J)  A2270 

C A2280 

IF  (ICOMP.EO.l)  GO  TO  200  A2290 

IH*IM*1  A2300 

SPLOIF*SPLA(I)-SPLM(IM,JJ)  A2310 

IF  (SPLMdM, JJ).LE. 10.0. OR. SPLA(I).LE. 10,0)  SPLDIF-9999999.9  A2320 

IF  (SPLMdM, JJ)  ,LE.  10.0. OR.SPLA(I).LE.  10.0)  GO  TO  190  A2330 

SUM0IF*SUMDIF*SPL0IF**2  A2340 

NF*NF«1  A2350 


4 


a... 


onn  non  o ooo  o non 


*2360 

WRiiE  PREDICTED  VALUES  (PACKAGE  A)  *2370 

*2380 

190  WRITE  (6.810)  FREQ(I) »5PL*(I) .SPLM(IH.JJ) .SPLDIF.SUMDIF  *2390* 

GO  TO  210  *2400 

200  WRITE  (6.820)  FREQ(I) «SPL*(I>  *2410* 

*2420 

210  CONTINUE  *2430 

IF  ( ICOMP.EO. 1 ) GO  TO  220  *2440 

STOEV-O.O  *2450 

IF  (NF.GT.0)  STOEV»SORT(SUHOIF/NF)  A2460 

WRITE  (6.830)  STOEV  A2470* 

A2480 

COMPUTE  PACKAGE  B IF  OPTION  NUMBER  IS  2.  4.  5.  OR  7 *2490 

A2500 

220  IF  (0PN0.E0.2)  GO  TO  230  A2510 

IF  (0PN0.EQ.4)  GO  TO  230  A2520 

IF  (OPNO.EO.S)  GO  TO  230  A2530 

IF  (0PN0.EQ.7)  GO  TO  230  A2540 

GO  TO  290  A2S50 

A2560 

230  CONTINUE  A2570 

A2580 

PACKAGE  B — TURBULENT  MIXING  N0ISE**«#«  A2590 

A2600 

WRITE  (6.840)  BOPNO  *2610* 

IF  (ISS.EO.l)  WRITE  (6.850)  A2620* 

IF  (NU.E0.3)  WRITE  (6.860)  A2630* 

IF  ( ICOMP.EO. 1)  GO  TO  240  A2640 

WRITE  (6.870)  TM(J)  A26S0* 

GO  TO  250  A2660 

240  WRITE  (6.880)  TM(J)  A2670* 

A2680 

BEGIN  FREQUENCY  LOOP  (PACKAGE  B)  A2690 

A2700 

250  SUMDIF-0.0  A2710 

IH-IOFF  A2720 

NF«0  A2730 

C A2740 

DO  280  1*1 .NFREO  *2750 

C *2760 

CALL  MXNOISE  (NU.lLWR.OPNO.BOPNO.IOPT.ROD.OFT.TOF.AO.VJ.VJAO.TJTO.  A2770S 
ll.FREO.S.ZM.SM.RSW.ALTB.BLTB.SPLB.SPLPO.SPLPO.INO)  *2780 

C *2790 

IF  (ICOMP.EO. 1)  GO  TO  270  *2800 

IH*IH»1  *2810 

SPLOIF*SPLB(I)-SPLM(IM,jj)  *2820 

IF  (SPLM(IM,JJ).LE'.10.0.0R.SPLB(I).LE.15.0)  SPLO I F *9999999 , 9 *2830 

IF  (SPLM(IH.JJ).LE. 10.0, OR. SPLB(!).LE, 15.0)  GO  TO  260  *2840 

SUM0IF*SUM0IF*SPL0IF**2  *2850 

NF  *NF ♦ 1 *2860 

260  WRITE  (6.890)  FREO(I) .S.SM.SPLPO.SPLPO.SPLB(I) .INO.SPLM(IH.JJ) »SPL  A2870* 
10IF.SUM0IF  *2880 

GO  TO  280  *2890 

270  WRITE  (6.900)  FREO(I) .S.SM.SPLPO.SPLPO.SPLB(I) .IND  *2900* 

C *2910 

280  CONTINUE  *2920 

C *2930 

IF  ( ICOMP.EO. 1)  GO  TO  290  *2940 
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STDEw.0.0  *2950 

IF  (NF.GT.O)  STDEVbSQRT (SUMDIF/NF)  *2960 

WRITE  (6*910)  STDEV  A2970* 

COMPUTE  PACKAGE  C »F  OPTION  NUMBER  IS  3*  5*  6*  OR  T A2980 

A2990 

290  IF  (OPNO.EO.3)  GO  TO  300  A3000 

IF  (OPNO.E0.5)  GO  TO  300  A3010 

IF  (0PN0.E0.6)  GO  TO  300  A3020 

IF  (0PN0.E0.T)  GO  TO  300  A3030 

GO  TO  3T0  *30*0 

A3050 

300  CONTINUE  A3060 

A3070 

PACKAGE  C — SHOCK  ASSOCIATED  NOISE*****  A3080 

A3090 

IF  (MJ.LE.1.0)  GO  TO  310  A3100 

A3110 

OF*(1,0-(MC*COS(ZM) ) ) A3120 

W0RK2* ( (L1*0F) / (VC* 12.0) ) A3130 

*31*0 

310  WRITE  (6.920)  TM(J|  A3150* 

IF  (ICOMP.EO.l)  GO  TO  320  A3160 

WRITE  (6.930)  A3170* 

GO  TO  330  A3180 

320  WRITE  (6,9*0)  A3190* 

A3200 

BEGIN  FREQUENCY  LOoP  (PACKAGE  C)  *3210 

A3220 

330  SUMDIF*0.0  *3230 

IH-I0FF  *32*0 

NF»0  *3250 

00  360  I-l.NFREQ  *3260 

A3270 

CALL  SAN0ISE  <BETA,TJTO,ROD.8C.DFT.AO,NFREQ,FREO,I.J.TM,LO.MJ,DF,W  *3280$ 
10RK2,NS.SPLC.HXX.HyY,CYY.A3,A2)  *3290 

A3300 

WRITE  PREOICTEO  VALUES  (PACKAGE  C)  *3310 

A3320 

IF  (ICOMP.EO.l)  GO  TO  350  *3330 

IH»IH*1  *33*0 

SPLDIF«SPLC(I)-SPLM(IH,JJ)  A3350 

IF  (SPLM(IH.JJ) ,LE. 10.0. OR. SPLC(I) ,LE, 10.0)  SPLDIF-9999999.9  A3360 

IF  (SPLMdH, JJ),LE. 10.0. OR. SPLCdJ.LE. 10.0)  GO  TO  3*0  A3370 

SUM0IF»SUM0IF*SPL0IF**2  *3380 

NF*NF*1  *3390 

3*0  WRITE  (6.950)  FREQ(I) .HXX.HYY.CYY, *3. *2. SPLC(I) . SPLMdH. JJ) .SPLOIF  *3*00* 
1 . SUMO IF  *3*10 

GO  TO  360  *3*20 

350  WRITE  (6,960)  FREQ(I) .HXX,HYY,CYY,*3»A2.SPLC(I)  *3*30* 

*3**0 

360  CONTINUE  *3*50 

*3*60 

IF  (ICOMP.EO.l)  GO  TO  370  *3*70 

STDEV»0.0  *3*80 

IF  (NF.GT.O)  STDEVbSQRT (SUMOIF/NF)  *3*90 

WRITE  (6,970)  STDEV  *3500* 

370  CONTINUE  *3510 

*3520 

THE  FOLLOWING  FOUR  SECTIONS  COMPUTE  THE  TOTAL  NOISE»«*##  *3530 


■f- 


I 

K 


••FOR  OPTION  NUMBERS 

4,  5.  6,  ANO 

*3540 

*3550 

IF  (OPNO.EQ.l) 

GO 

TO 

620 

*3560 

IF  (0PN0.EQ.2) 

GO 

TO 

620 

*3570 

IF  (0PN0.EQ.3) 

GO 

TO 

620 

*3580 

IF  (OPNO.EQ.4) 

GO 

TO 

380 

*3590 

IF  (0PN0.EQ.5) 

GO 

TO 

440 

*3600 

IF  (0PN0.EQ.6) 

GO 

TO 

520 

*3610 

IF  (0PN0.EQ.7) 

GO 

TO 

540 

*3620 

*3630 

COMPUTATION  FOR  OPTION  4 — TOTAL 

NO I St  ■ A*B 

*3640 

c 

c 

c 


380  WRITE  (6.980)  TM(J) 

IF  (ICOMP.EO.O)  WRiTE  (6,990) 

IF  (ICOMP.EQ.l)  WRITE  (6,1000) 

SUMDIF-0.0 

IHmIOFF 

NF«0 

00  430  I-l.NFREQ 

SPLT(I)«10.0»AL0010(10,0*»(SPLA(I)/10.0I*10,0*«(SPLB(I)/10,0) ) 

IF  (ICOMP.EQ.l)  GO  TO  420 
IMbIh.1 

SPLDIF«SPLT(I)-SPLM(IM,jj) 

IF  (SPLM(IH,JJ).LE.10,0)  GO  TO  390 
IF  (SPLT(I) .LE.15.0)  GO  TO  390 
GO  TO  400 

390  SPL0IF»9999999.9 
GO  TO  410 
400  CONTINUE 

SUMO IF«SUMDIF« SPUD I F«*2 
NF«NF*1 

410  WRITE  (6.1010)  FREQ(I) ,SPLA(I) ,SPLB(I) *SPLT(I) ,SPLM(IH»JJ) .SPLOIF, 
1 SUMO IF 
GO  TO  430 

420  WRITE  (6.1020)  FREQ ( I ) , SPL* ( I ) .SPLB ( I ) »SPLT ( I ) 

430  CONTINUE 

IF  (ICOMP.EQ.l)  GO  TO  620 
STOEV-O.O 

IF  (NF.GT.O)  STDEVbSQRT (SUMDIF/NF) 

WRITE  (6,1030)  STDEV 
GO  TO  620 

COMPUTATION  FOR  OPTION  5 — TOTAL  NOISE  ■ B»C 

440  WRITE  (6.1040)  TM(J) 

IF  (ICOMP.EQ.l)  GO  TO  450 
WRITE  (6,1050) 

GO  TO  460 
450  WRITE  (6.1060) 

460  CONTINUE 
SUMDIF-0.0 
I H- I OFF 
NF»0 

DO  510  I»1 .NFPEQ 

SPLT ( I >«10.0*AL0Gl0 ( 10 ,0#* (SPLB ( I ) /10 ♦ 10, 0** (SPEC ( I ) /10.0  > ) 


*3650 

*3660» 

*3670* 

A3680* 

*3690 

*3700 

*3710 

*3720 

*3730 

*3740 

*3750 

*3760 

*3770 

*3780 

*3790 

*3800 

A3810 

*3820 

*3830 

*3840 

*3850 

*3860 

*3870* 

*3880 

*3890 

*3900* 

*3910 

*3920 

*3930 

*3940 

*3950 

*3960* 

*3970 

*3980 

*3990 

*4000 

*4010* 

*4020 

*4030* 

A 4040 

*4050* 

*4060 

*4070 

*4080 

*4090 

*4100 

*4110 

*4120 


r:..  *V.  • V 


uu  u u u uou 


. - • - 


IP  dCOMP.EO.l)  00  TO  Soo  **130 

A*1*0 

SPLDIP«SPLT(I>-SPLM(IH,JJ)  A*150 

If  (SPLM(IH.JJ) .LE.10.0)  GO  TO  *70  **160 

IP  (SPLB(I) .LE.15.0)  60  TO  *70  A*170 

IP  (SPLC(I).LT.IO.O)  60  TO  *70  A*180 

00  TO  *80  A*190 

*70  SPLDIP-9999999.9  A*200 

00  TO  *90  A*210 

*80  CONTINUE  A*220 

SUM0IP«SUMDIP*SPL0lP»«2  A*230 

NP"NP ♦ I A*2*0 

*90  WRITE  (6*1070)  FREQ(I) .SPLB(I) »SPLC(I) iSPLT(I) .SPLM(IM.JJ) .SPLDIP.  A*250* 
1 SUMO I P A*260 

00  TO  510  A*270 

500  CONTINUE  A*2B0 

WRITE  (6,1080)  PREOdl.SPLB(I),SPLCd)iSPLTd)  A*290* 

510  CONTINUE  A*300 

C A <*310 

IP  (ICOMP.EQ.l)  00  TO  620  A*320 

STOEV-O.O  **330 

IP  (NF.GT.O)  STOEV«SORT (SUMOIP/NP)  A<*3<*0 

WRITE  (6.10901  STDEV  A*350* 

00  TO  620  A*360 

A*370 

COMPUTATION  FOR  OPTION  6 — TOTAL  NOISE  > A»C  A*380 

A <*390 

520  WRITE  (6.1100)  TM(J>  ***00« 

A <*<*10 

00  530  I-l.NFREQ  A<*<*20 

SPLT ( 1 1 »10.0#ALOG10 ( 10 ,0** (SPLA (11/10.0) *10.0** (SPLC (11/10*0) ) A**30 

WRITE  (6.1110)  PREO(I)  .SPLA(I)  .SPLC(I)  .SPLT(I)  A***0* 

530  CONTINUE  A**50 

A **60 

GO  TO  620  A**70 

A **80 

COMPUTATION  FOR  OPTION  7 — TOTAL  NOISE  » A.B.C  A**90 

A*500 

5*0  WRITE  (6.1120)  TM(j)  A*510* 

IF  dCOMP.EO.l)  GO  TO  550  A*520 

WRITE  (6,1130)  AA530* 

GO  TO  560  A4540 

550  WRITE  (6.11*0)  A*550* 

560  CONTINUE  **560 

C A*5T0 

SUMDIF-0.0  A*580 

IM-IOFF  A*590 

NF»0  A*600 

00  610  I-l.NFREO  A*610 

SPLT ( I ) ■10.0«ALOG10 ( 10,0** (SPL* ( I ) /10.0) *10.0** (SPLB (I)/10.0)*10.0  A*620 

1**(SPLC(I)/10.0)>  **630 

IF  (ICOMP.EQ.l)  GO  TO  600  A*6*0 

IH-IM.l  A*650 

SPLOIP»SPLT(I)-SPLM(IM,jj)  A *660 

IF  (SPLM(IM.JJ) .LE.10.0)  GO  TO  570  **670 

IP  ( < SPL * 1 1 ) .LE, 10. . ANO.SPLB ( I ) .LE.15.) .OR.SPLC(I) .LE.10.)  GO  TO  5 A*680 

170  A*690 

GO  TO  580  A*700 

570  SPLDIP ■9999999, 9 A*710 
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GO  TO  590  A4720 

580  SUMDir-SUM0IF*SPL0lF*»2  A4730 

NF*NF  *1  44740 

590  WRITE  (6, U50)  FREQ(I) ,SPLA(I) ,SPLB(I) »SPLC(I> »SPLT(I> »SPLM(IH,JJ)  A4750* 
1 • SPLDIF , SUM  A4760 

GO  TO  610  A4770 

600  CONTINUE  A47B0 

WRITE  (6.1160)  FREO(I) .SPLA(I) .SPLB(I) .SPtC(I) »SPLT(1)  A4790* 

610  CONTINUE  A4800 

C A4810 

IF  (ICOMP.EQ.l)  GO  TO  620  A4820 

STDEVaO.O  A4830 

IF  (NF.GT.O)  STOEVaSQRT (SUMOIF/NF)  A4840 

WRITE  (6.1170)  STDpV  A4850* 

GO  TO  620  A4860 

A4870 

ENO  ANGLE  LOOP  A4880 

A4890 

620  CONTINUE  A4900 

GO  TO  40  A4910 

630  STOP  A4920 

C A4930 

640  FORMAT  ( IH1 , 10X,"DATE  " . 1A10 . 10X,«TIME  "»lA10»//>  A4940 


650  FORMAT  (2X,"*«*LARGE  SCALE  NOISE  FAILURES  ARE  INDICATED  BY  THE  ",«  A4950 

1 FOLLOW I NG***",//,5x."SPLAal .0  STABILITY  CALCULATIONS  PailED  TO  CO  A4960 
2NVERGE" ./5X,"SPLAa2.0  LARGE  SCALE  NOISE  AT  THIS  JET  VELOCITY  IS  N A4970 
3EGLECTED  «,/5X,«SPLAa3.0  LARGE  SCALE  NOISE  AT  THIS  ANGLE  IS  NEGLE  A4980 
4CTED»,/5X,»SPLAa4.0  LARGE  SCALE  NOISE  AT  THIS  FREQUENCY  IS  NEGLEC  A49-'" 
5TEO"./.5X.”SPLAa5,0  SEARCH  FOR  STARTING  VALUES  GIVES  SINGULAR  MAT  A5000 
6RIX",////)  A5010 

660  FORMAT  (2X. •••••TURBULENT  MIXING  NOISE  (80PN0  1)  FAILURES  ARE  INDIC  A5020 
1ATEO  BY  THE  FOLLOWING***", //5X,"SPLB«1 .0  VELOCITY  PROFILE  GRAOIEN  A5030 
2T  IS  NOT  AVAILABLE". /5X,»SPLBa2,0  SM  IS  OUTSIDE  THE  RANGE  OF  SOUR  A5040 
3CE  OATA»,/5X,»SPLBa3.0  SOURCE  DIRECTIVITY  EXPRESSION  IS  LESS  THAN  A5050 
4 2ER0",/5X,"SPLBa4.0  NUMBER  OF  ITERATIONS  EXCEEDS  50"»/5X,"SPLBa5  A5060 

5.0  SM  GOES  NEGATIVE  IN  ITERATION  ROUTINE", /5X,"SPLB»6.0  ARGUMENT  A5070 

6 X IN  DECAY  FACTOR  IS  NEGATIVE". /5X,"SPLBa7,0  RADIATION  ANGLE  IS  A5080 
7LESS  THAN  30.0  DEGREES", /5X,"SPLB*8.0  TURBULENT  MIXING  NOISE  AT  T A5090 
SHIS  ANGLE  AND  JET  ", "VELOCITY  IS  NEGLECTED",////)  A5100 

670  FORMAT  (2X,"***TURBULENT  MIXING  NOISE  (BOPNO  2)  FAILURES  ARE  INDIC  A5110 
1ATEO  BY  THE  FOLLOWING***",//5X,"SPLB*2.0  SM  IS  OUTSIDE  THE  RANGE  A5120 
20F  SOURCE  DATA",/5X,"SPLBa3.0  SOURCE  DIRECTIVITY  EXPRESSION  IS  LE  A5130 
3SS  THAN  ZERO",/5X,nSPLBa4.0  NUMBER  OF  ITERATIONS  EXCEEDS  S0",/5X,  A5140 

4"SPLB*5.0  SM  GOES  NEGATIVE  IN  ITERATION  ROUTINE", /5X,"SplB»8,0  T A5150 
5URBULENT  MIXING  NOISE  AT  THIS  ANGLE  AND  JET  "."VELOCITY  IS  NEGLECT  A5160 
6ED»,/,5X,"SPLBa9.0  CRITICAL  LAYER  RADIUS  TOO  SMALL",/*5X,"SPLB«10  A51T0 

7.0  BESSEL  FUNCTION  FAILURE", /,5X,"SPLB"11.0  SOURCE  AND  CRITICAL  A5180 

SLAYER  RADIUS  COINCIDE".////)  A5190 

660  FORMAT  (2X,"***SH0CK  ASSOCIATED  NOISE  FAILURES  ARE  INDICATED  BY  TH  Ab200 
IE  FOLLOWlNG***»,//5X."SPLCal.O  MJ  IS  LESS  THAN  1 .0"»/SX,"5PLCa2.0  A5210 

2 SIGMA  IS  OUTSIDE  THE  RANGE  OF  MASTER  SPECTRA", /5X,"SPLCO.O  SHO  A5220 
3CK  NOISE  CONTRIBUTION  AT  THIS  ANGLE  AnO  JET","  TEMPERATURE«/15X,"C  A5230 


4AN  BE  (ANO  IS)  NEGLECTED")  A5240 
690  FORMAT  (8F10.0)  A5250 
700  FORMAT  ( 1615)  A5260 
710  FORMAT  (12F6.1)  A5270 


720  FORMAT  < 1H1 ,//////l7X.40H****»  UNIFIED  JET  NOISE  PREDICTION  •*•••»  A52B0 

1///32X.10HTEST  POINT, 14, ///31X.13HOPTION  NUMBER, 13, ///5X.20HRESERV  A5290 
20IR  PRESSURE  a,F6.2,28H  PSI,  ATMOSPHERIC  PRESSURE  a,F6.2,4H  PSI./l  A5300 


3X.23HRESERV0IR  TEMPERATURE  *,F7.1,29H  DEQ.F,  CHAMBER  TEMPERATURE  • A5310 

4.F7.1.CH  DEG.F,/31XtTH6AMMA  »,F5.2>  A5320 

T30  FORMAT  (//10X.22HPRESSURE  RATIO  PR/PO  ■»F6.3,/10X»25HTEMPERATURE  R A5330 
1ATIO  TR/TO  ■*F6,3*/10X» 36HJET  STATIC  TEMPERATURE  RATIO  Tj/TO  *.F6,  A53A0 

23./10X.25HJET  DENSITY  RATIO  OJ/DO  ■,F6.3,/10X,26HJET  VELOCITY  RATI  AS350 
30  VJ/AO  *,F6.3,/10X,20HJET  MACH  NUMBER  MJ  »,F6,3»/10X»17HJET  VELOC  A5360 
4ITY  VJ  -fFTtltAH  FPS)  A5370 

7 AO  FORMAT  (//10X,17HNoZZLE  DIAMETER  *,F6.2*7H  INCHES, /10X*21HMICROPHO  AS380 
1NE  DISTANCE  -.F6.2.5M  FEET./10X.SHR/0  «»F6.2>  A5390 

7S0  FORMAT  (//, 10X. "TURBULENCE  INTENSITY  RADIAL  HALF  WIDTH  • ".E13.6)  A5400 

760  FORMAT  (10X,«RAOIAL  COHERENCE  LENGTH  SCALE  COEFFICIENTS  (A. B>  • ",  A5410 

IE  13.6*"  , "*E13,6)  A5420 

770  FORMAT  (///10X,37H**SHOCK  ASSOCIATED  NOISE  PARAMETERS**, ///10X.3HC  A5430 

1 *,F5.2,5X,4HK0  ■,F5.2,5X,4HK1  ■,F5.2,/l0X,21HNUMBER  OF  SHOCKS  NS  A5440 
2*, 13)  A54S0 

780  FORMAT  (//10X,6HBEtA  *,F6.3,/I0X,29HEDOY  CONVECTION  VELOCITY  VC  •,  A5460 

1F7.1.4H  FPSt/1 0X,3pHEDDY  CONVECTION  MACH  NUMBER  MC  *»F6,3»/10X,30H  A5470 

2AVERASE  SHOCK  CELL  LENGTH  LO  *.F7,3,7H  INCHES, /10X,28H? IRST  SHOCK  A5480 
3CELL  LENGTH  LI  «,F7.3»7h  INCHES)  A5490 

790  FORMAT  (1H1 »//////, 5X, "NOISE  FROM  LARGE-SCALE  TURBULENCE  ", "STRUCT  A5500 
1URE",///,SX, "OBSERVER  ANGLE  *",F7.2,"  DEGREES",///, IX, 3X,»FRE0(HZ)  A5510 
2",4X,»SPLA(DB)",16X,"SPLM(DB)",4X,"DIF?",9X,"SUM",/)  A5520 

800  FORMAT  ( IH1 ,//////5X, "NOISE  FROM  LARGE-SCALE  TURBULENCE  STRUCTURE"  A5530 
1 , ///5X , 1 6H0BSERVER  ANGLE  *,F7(2,8H  DEGREES , /// 1 X , 3X , "FREQ ( HZ ) » , 4X , A5S40 

2"SPL* (DB) "/)  A5550 

810  FORMAT  (2X,2F10.1,14X,2(4X,F6.1) .2X.F12.1)  A5S60 

820  FORMAT  (2X.F10. 1 ,FiO.  1 ) A5570 

830  FORMAT  <//,40X, "STANDARD  DEVIATION  ■ "»F7,2)  A5580 

840  FORMAT  ( 1H1 ,////,5x, "TURBULENT  MIXING  NOISE  (BOPNO  *".I2,")")  A5590 

850  FORMAT  (/, T2,"***  ALTERNATIVE  AXIAL  SOURCE  LOCATION  MODEL  ","UTILI  A5600 
1ZED  ***")  AS610 

860  FORMAT  (/,T2."***  DISPLACEMENT  SOURCE  MOOEL  ••••')  A5620 

870  FORMAT  (///,5X, "OBSERVER  ANGLE  ■",F7.2»"  DEGREES",///, IX, 3X,»FREQ(  A5630 
lH2)",4X,"FD/VJ",6Xt"SM"f5X,«SPLP0(DB)",lX,"SPLP0(DB)M,2X,HSPLB(0B)  A5640 
2", 16X,"SPLM (08) ",4x,"0IFF«,9X, "SUM",/)  A5650 

880  FORMAT  (///*5X» I6H0B SERVER  ANGLE  >,F7.2,BH  DEGREES. ///IX, 3X,"FREO(  A5660 
lHZ)",4X,"FD/VJ",6Xt"SM",5X»"SPLP0(DB)",lX,"SPLPD(DB)",2X,MSPLB(0B)  A5670 
2"/)  A5680 

890  FORMAT  (1X,F10.1,2F10.3,3F10.1,2X,A2,10X,2(4X,F6.1) ,2X,F12.1)  A5690 

900  FORMAT  (1X,F10.1,2F10.3,3F10.1,2X,A2)  A5700 

910  FORMAT  (//,74X, "STANDARD  DEVIATION  * ",F7.2)  A5710 

920  FORMAT  <1 HI, //////5X, "SHOCK  ASSOCIATED  NOISE", ///SX.ISHOBSERVER  an  A5720 
1GLE  *»F7,2*8H  DEGRfES.///)  A5730 

930  FORMAT  ( 1X,3X, "FREQ (HZ) ",3X, "SIGMA", 3X»"H0 (DB) ",3X, "Cl", 3X,"ANS3 (D  A5740 
lB)",3X,"ANS2(DB)",5X,"SPLC(DB)".16X,"SPLM(DB)",4X,"DiFF",9X,"SUM",  A5750 

2/)  A5760 

940  FORMAT  ( *X,3X,«FREQ(HZ) " , 3X, "SIGMA", 3X, "MO (OB) «,3X,"Cl",3X,"ANS3 (D  A5770 
IB) "«3X« "ANS2 ( DB ) " , 5X , "SPLC  < DB ) "/)  A5780 

950  FORMAT  (2X,F10,1,3X,F5.2,3X,F6.1,2X,F4.2,2X,F7,1,4X.F7.1,5X,F7.1,1  A5790 

15X,2(4X,F6.1) ,2X,F12.1)  A5800 

960  FORMAT  <2X,F10.1,3x,F5.2,3X,F6.1,2X,F4,2,2X,F7.1,4X,F7.1,SX,F7.1>  A5810 

9/0  FORMAT  <//*85X, "STANDARD  DEVIATION  ■ ",^7,2)  A5820 

980  FORMAT  (1H1.//////5X, "TOTAL  NOISE", ///SX, 16H0BSERVER  ANGLE  *,F7,2,  A5830 

18H  DEGREES,///)  A5840 

990  FORMAT  ( 1X,4X,"FREq (HZ) ", 3X,"SPLA (DB) ",2X,"SPLB (DB) ",2X,"SPLT (DB) » A5850 

1,19X,"SPLM(DB)",19X,"DIFF",13X,"SUMDIFF",/)  A5860 

1000  FORMAT  (1X,4X,"FRE0(HZ)",3X,"SPLA(DB)",2X,"SPLB(DB)"«2**"SPLT(DB)«  A5870 

1,/)  *5880 

1010  FORMAT  (2X,4F10.1,i9X,Fl0.1,14X,F6.1,8X,F12.1)  A5890 


i " -J- 


1020  FORMAT  (2X.4F10.1) 

1030  FORM*T  (//.T79. "STANDARD  DEVIATION  ■ "»F6,1> 

1040  FORMAT  ( 1H1 ,//////5X, "TOTAL  NOISE", ///5X, 16H0BSERVER 
18H  DEGREES.///) 

1050  FORMAT  < 1X,4X,"FREQ(HZ) ",3X,"SPLB (DB) "»2X,"SPLC (OB) ". 
1,16X,"SPLM(DB>",4X,"DIFF",9X,"SUM",/) 

1060  FORMAT  (1X,4X,"FREQ(HZ)",3X,"SPLB(DB)"»2X,«SPLC<DB>"» 
1/) 

10T0  FORMAT  (2X.4F10,l.l6X.2(4X.F6,l) .2X.F1Z.1) 

1080  FORMAT  (2X.4F10.1) 

1090  FORMAT  (//.T64. "STANDARD  DEVIATION  ■ "»F6.1) 

1100  FORMAT  (1H1.//////5X, "TOTAL  NOISE". ///5X, 16H0BSERVER 
IBM  DEGREES. ///IX, 4X. "FREQ (HZ) ".3X,«SPL*<DB)m.2X."SPLC 
2T (DB)"/) 

1110  FORMAT  (2X.4F10.1) 

1120  FORMAT  (1H1.//////5X, "TOTAL  NOISE", ///5Xt 16H0B SERVER 
18H  DEGREES.///) 

1130  FORMAT  ( 1X,4X»"FREQ(HZ) ",3X»"SPLA (DB) ",2x,"SPLB (DB) ", 
1.2X,"SPLT(DB)".16X,"SPLM(DB)",4X."DIFF"»9X,"SUM",/) 

1140  FORMAT  (1X,4X,"FREQ(HZ)",3X,"SPLA(DB)»*2x,"SPLB(DB)", 
1.2X,"SPLT(DB)"/> 

1150  FORMAT  (2X,5F10,1.15X«2(4X.F6.1) .2X.F12.1) 

1160  FORMAT  (2X.5F10.1) 

1 1T0  FORMAT  (//.T71 ."STANDARO  DEVIATION  ■ "*F6.1) 

END 


ANGLE  ».FT.2, 
2X»«SPLT (OB) " 
2X."SPLT(DB)" 


ANGLE  -.FT. 2. 
(OS) ",2X."SPL 


ANGLE  "^7.2. 
2X,«SPLC (DB) " 
2At"SPLC(DB)" 


A5900 

A5910 

A5920 

A5930 

A5940 

A5950 

A5960 

A5970 

A5980 

A5990 

A6000 

A6010 

A6020 

*6030 

*6040 

A6050 

A6060 

A6070 

A6080 

*6090 

A6100 

*6110 

*6120 

A6130 

A6140* 


I 
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•DECK  CALPEK 

SUBROUTINE  CALPER  (VJAO, TJTO.PO. TOE. TRF.PRG.TRK.TRTOtPRPO. PROA, DJD  B 10 


10»MJ.A0.VJ.GAMA,OPpER)  B 20 

REAL  MJ  6 30 

INTEGER  OPPER  B 40 

DIMENSION  GAM (11)  B SO 

IP  (OPPER.EQ.l)  GO  TO  30  B 60 

B 70 

CALCULATIONS  FROM  INPUT  OF  TJT0»VJA0,T0F, A NO  PO  B 80 

B GO 

TRK«5./9.*(T0F*460.0»*TJT0  B 100 

T0Ka(S.0*(T0F*460.0» )/9.0  B 110 

GAMA0»1. 421- (TOK/1 1800.0) ♦ (EXP (-ABS(TOK-450.0)/200.0> /BO. 0)  B 120 

IF  (TOK.LE. 290.0)  GAMA0-1.402  B 130 

AO«SORT (GAMA0*1716.8* (T0F*460«0) ) B 140 

TJK»TJT0*T0K  B 150 

GAMAJ>1.421-(TJK/11800.0)*(EXP(-ABS(TJK-450.0)/200.0)/B0,0)  B 160 

IF  (TJK.LE. 290.0)  GAMAJal ,402  B 170 

GJGO«GAMAJ/GAMAO  B 180 

MJ«VJAO/SQRT(GJOO*TJTO)  b igo 

VJ*VJA0*A0  B 200 

DJOOal.O/TJTO  B 210 

GAM(1)>0.0  B 220 

DO  10  1*2,11  B 230 

GAM< I )*1.421>(TRK/i 1800.0)* (EXP (•ABS(TRK.450.0)/200.0)/80.0)  B 240 

IF  (TRK.LE. 290.0)  GAM ( I ) «1 .402  B 250 

PRGA»1 ,0* ( (GAM ( I ) -1 .0) /2,0#MJ**2)  B 260 

PRP0«PRGA*»(GAM(I)/(GAM(I)-1,0) ) B 270 

TRT0*TJT0»PRGA  B 280 

TRK*5,/9.*(T0F*460.0>*TRT0  B 2G0 

PRO* (PRPO-1 .0) *P0  B 300 

TRF*TRT0*(T0F. 460.0) “460,0  B 310 

diff>abs(gam(d-gam(I-d ) b 320 

J J* I B 330 

IF  (OIFF ,LE, 0,0001)  GO  TO  20  B 340 

10  CONTINUE  B 350 

WRITE  (6,40)  8 360* 

STOP  100  B 370 

20  GAMAsGAM(JJ)  B 380 

RETURN  B 390 

B 400 

CALCULATIONS  FROM  JNPUT  OF  PO.TOF.PRG.  *NO  TRF  B 410 

B 420 

30  PRPO" (PRG/PO) *1.0  B 430 

TRT0*(TRF*460.0)/(T0F*460.0|  B 440 

TRK* (5. 0* (TRF *460.0) ) /9.0  B 450 

GAMA«1.421- (TRK/1 1800.0)* (EXP(>ABS(TRK>450.0)/200.0 1/80.0)  B 460 

IF  (TRK.LE. 290.0)  GAMA*1.402  B 470 

PRGA«PRP0»«( (GAMA-i.O)/GAMA)  B 480 

MJ«SORT ( f 2.C/ (GAMA.l , 0 ) ) • (PRGA- l .0 ) ) B 490 

TJT0«TRT0/PRGA  B 500 

DJD0*1 .O/TJTO  B 510 

T0K» (5.0* (TOF *460.0) )/9.0  B S20 

GAMA0«l, 421- (TOK/1 1800.0) ♦ (EXP (-ABS(T0K-450.0)/200.0)/80.0)  B 530 

IF  (TOK.LE. 290.0)  GAMA0-1.402  B 540 

A0*SQRT (GAMA0*1716,6* (TOF *460.0) ) B 550 

TJK*TJT0*T0K  B 560 

GAMAJal, 421-(TJK/li600,0)*(EXP(-ABS(TjK-450.0)/200.0)/80,0)  B 570 

IF  (TJK.LE. 290.0)  GAMAJ.1.402  B 580 
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gjgo-gamaj/gamao  e 590 

VJAO>MJ*SQRT(GJGO*TJTO>  B 600 

VJ»VJA0«A0  B 610 

RETURN  B 620 

B 630 

AO  FORMAT  (///, IX, "««•**  THE  GAMA  ITERATION  FAILED  TO  CONVERGE  «,"AFT  B 6A0 

1ER  10  TRIES.  COMPUTATION  STOPPED  . CHECK  INPUT.  •••••”>  B 650 

ENO  B 660« 
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•DECK  LSMAIN 

SUBROUTINE  LSMAJN  (VJA,TJT»OAMA,DFT,VJ*T,I,NANG,TM,IFN*SPlLS)  C 10 

C 20 

THIS  PROGRAM  IS  AN  INTERMEDIATE  STEP  BETWEEN  UNIMAIN  ANO  C 30 

LSNOISE  TO  HANOLE  INITIALIZATION  AND  SRROR  PROCESSING  C AO 

c SO 

DIMENSION  TM(20),PTHETA(20),POB(20),SPLLS(30,20)  C 60 

COMPLEX  ALPMA,OKOB  C 70 

REAL  MACH2,MLS  C 60 

INTEGER  GAMMA  C 90 

COMMON/ 1 NFO/ALPHA , OME  GA • MACH2  * T JTO  * NORO , GM l , 0KD8 , IFL® » V JAO  C 100 

TJTO-TJT  C 110 

VJAO-VJA  C 120 

IFLG-IFN  C 130 

B0-0.05  C 1A0 

GAMMA-8  C ISO 

INF-0  C 160 

RAONF-O.  C 170 

RSTART-0,  C 160 

XLAST-0.  C 190 

FREG-F  C 200 

IEROR-O  C 210 

SN-F-OFT/VJ  C 220 

MLS-17.2«ALOG10(10.0-SNt  C 230 

CLS-7A.13-SN—1. 0,136)  C 2A0 

CAL-MLS-10.0*ALOGlo(VJAO)*CLS  C 250 

IF  (VJAO.LT.1.15)  GO  TO  20  C 260 

IF  (SN.LT.0.1.0R.SN.GT.0.5)  GO  TO  AO  C 270 

CALL  LSN01S  (FREO,TM, NANG, GAMA, DFT,VJ,B0, GAMMA, INF,RADNF,XLAST,RST  C 260S 

1ART,PTMETA,PDB,IERDR)  C 290 

IF  (IEROR.EO.l)  RETURN  C 300 

IF  (IEROR.EQ.2)  GO  TO  60  C 310 

DO  10  J-l, NANG  C 320 

SPLLS<r,J)-POB(J|,cAL  C 330 

IF  (TM<J) ,LT,15,0,OR.TM(J) .GT.A5.0)  SPLLS ( I , J) -3,0  C 3A0 

10  CONTINUE  C 350 

RETURN  C 360 

20  DO  30  J-l ,NANG  C 370 

30  SPLLS(I.J)>2,0  C 380 

RETURN  C 390 

AO  00  50  J-l , NANG  C A00 

50  SPLLS(I,J)-A.O  C A10 

RETURN  C A20 

60  DO  70  J-l, NANG  C A30 

70  SPLLS ( I , J) -5, 0 C AAO 

RETURN  C A50 

ENO  C 460- 
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•DECK  LSNOISE 

SUBROUTINE  L SNO 1 5 < FREQ , TM , NANG , GAMA t OF T , V J • BO • GAMMA , 1 NF , RADNF , XL A 
1 ST . RSTART t PTHETA  , POB . I EROR ) 

DIMENSION  TM(NANG)«PTHETA(NANG) .POB(NANG) 


this  program  determines  the  growth  of  pressure 
FLUCTUATIONS  IN  A DIVERGING*  COMPRESSIBLE 
AXISYMMETRIC  JET. 


COMPLEX  PY(3)*YO).OY(3)*P(3) *0(3). ACON(130),BB(130) (ALPHA 
COMPLEX  BB4.CSTEP.LIM<6>  .RADC.RAD,DIR<6) 

complex  uval • duval • c val * l amoam . l amoap *et ac 
COMPLEX  RHO.ORHO.aC.PP.DPP.ADATUOO) *CDAT(100> 
complex  0U0S.02U0RS.0R0S.02R0RS 

COMPLEX  HSUM (2*3.2) » I SUM (2*2) .OUMH (3) .0UM.DUM1 ,L1 *L2 

complex  dkob 

COMPLEX  ARG.H0l.H02, HU, H12.I0.il 
COMPLEX  E0.E1.E2.E3.A2.A4 
real  MACH2 

INTEGER  GAMMA 
DIMENSION  SDAT(IOO) 

COMMON/ I NFO/ ALPHA , OMEGA .MACH2 . T JTO , NORD ,GM1 , DKDB . IFLG, V JAO 
COMMON/SPR/HTHETA.S.KEYl .UCENT.DUCDS.BETAl .BETA2, IFUNC 
COMMON/DECAY/  ID, SO 
SMIN1«2«5E»4 
SMAXl-,05 
ERMIN-.l 
ERMAX*. 14 
ERMIN-,1 
ERMAXa, 14 
PI-3. 1*159265 
A*. 693147 
STRNOaFREO»DFT/VJ 
NTTaO 
ID"0 

SD-1000. 

SET  UP  CONDITIONS  FOR  STABILITY  CALCULATION 

STARTING  RADIUS 
RSTlaO.OS 

FINISHING  RADIUS 

RFIN»4. 

DIMENSIONS  OF  COMPLEX  CONTOUR  DEFORMATION 
ETAU-0.5 
ETA21-0.5 

NUMBER  OF  THICKNESSES  TO  BE  CALCULATED 

NLlMaTO 

3«  VARIATION  IN  PERCENTAGE  FOR  WAVENUMBER  GUESSES 

PERCRaO.OOS 
PERClaO.OOS 
THICKNESS  STEP  SIZE 
DSa0.005/STRNO 

STARTING  THICKNESS  FOR  BOUNDARY  LAYER 
SaO.OS-DS 

SET  UP  CALCULATED  VALUE  OF  MODENUMBER 

NOROal 


D 100 
D 110 
D 120 
D 130 
0 140 
D 150 
0 160 
0 170 
D 180 
D 190 
D 200 
D 210 
0 220 
D 230 
D 240 
0 250 
0 260 
D 270 
0 280 
D 290 
0 300 
D 310 
0 320 
D 330 
D 340 
D 350 
D 360 
D 370 
0 380 
D 390 
D 400 
D 410 
D 420 
D 430 
D 440 
0 450 
D 460 
D 470 
D 480 
D 490 
D 500 
D 510 
D 520 
D 530 
D 540 
D 550 
0 560 
D 570 
D 580 


uuu  oooo  uuu  uuu 


ANaPLOAT(NORO) 

GMlaGAMA-l 
HACH2»VJA0»VJA0 
N0R01aN0RD»l 
10  S-S.DS 

ADJUST  MINIMUM  AND  MAXIMUM  STEP  SIZES  TO  THE  LOCAL  WIDTH 

smin>smini*s 

SMAXaSMAXl'S 

IP  (SMIN.GT.SMIN1)  SMlNaSMlNl 
IP  (SMAX.LT.SMAX1)  SMAXaSMAXl 
ETA1«ETA11*S 
ETA2«ETA21«S 

CALCULATE  THE  LOCAL  POTENTIAL  CORE  RADIUS 
OR  THE  CENTERLINE  VELOCITY 

KEYIO 

BETAl-O. 

BETAZaO. 

UCENT-l. 

RAOaCMPLXI*. 0125.0.) 

DO  20  I-1.161 
RADaRAD.,025 

CALL  UEVAL  ( RAD .UVAL .DUVAL. DUDS • D2U0RS * RHO . DRHO . DRDS . D2RDRS ) 
VALaREAL (RHO*UVAL*UVAL) 

BETAlaBETAl.VALa.0z5 
BETA2aBETA2* VALaREAL (RAD) *,025 
IP  (ABS(VAL>.LT.l.E-5)  GO  TO  30 
20  CONTINUE 

CALCULATION  OP  THE  POTENTIAL  CORE  RADIUS 

30  VALaSaSa<(TJT0*BETAl)*a2-2.*TJT0*BETA2)*l, 

IP  (VAL)  70. A0. 40 
40  VALa-SaBETAiaTJTO.SQRT(VAL) 

IP  (VAL)  70.50.50 
50  HTHETAaVAL 
KEYI-1 

IP  (HTHETA.LT.RST1)  GO  TO  60 
RST»HTHETA. , IE-1  0 
GO  TO  150 
60  RSTaRSTl 
GO  TO  150 

CALCULATION  OP  THE  CENTERLINE  VELOCITY 

70  KEYla* 

60  BETAEaO, 

RAOaCMPLXI-, 0125.0.) 

USAVEaUCENT 
DO  90  Ial,161 
RAOaRAO.,025 

CALL  UEVAL  ( RAD , UVAL . DUVAL • DUOS • D2UDRS * PHO » DRHO • DRDS . 02RDRS > 
VALaREAL ( RHO*UVAL*UVAL ) 

BETA2»BETA2.VAL*REAL (RAD) a,025 
IP  (ABS(VAL).LT.l.E-S)  GO  TO  100 
90  CONTINUE 


D 590 
D 600 
D 610 
0 620 
D 630 
D 640 
D 650 
D 660 
0 670 
D 680 
0 690 
D 700 
D 710 
D 720 
D 730 
0 740 
D 750 
0 760 
D 770 
D 780 
0 790 
D 800 
D 810 
D 820 
0 830 
D 840S 
0 850 
D 860 
D 870 
D 880 
D 890 
D 900 
0 910 
O 920 
D 930 
O 940 
D 950 
0 960 
O 970 
0 980 
0 990 
D1000 
D1010 
01020 
01030 
01040 
D1050 
D1060 
01070 
01080 
01090 
D1100 

oiiio 

01120 

D1130S 

01140 

01150 

01160 

01170 


uuuo  uuu  uuu  uuu  uuu 


100  UCENTb1./SQRT(2.«TjT0*BETA2)/S 

IF  (ABS(UCENT-USAVEJ.LT.l.E-4)  60  TO  110 
GO  TO  80 

CALCULATION  of  rate  OF  CHANGE  OF  CENTERLINE  VELOCITY 
WITH  LOCAL  THICKNESS 

110  AA*GHl*MACH2/2» 

BAb(I.-TJTO-AA) 

AK«SQRT(BA*BA*4,»A*) 

IF  (VJA0.lt, l.E-10)  GO  TO  120 

DUCDS— ( ( AA*UCENT*BA ) *UCENT-1 . ) • ( ALOG ( ABS ( (AA*UCENT*BA) *UCENT-1 . ) ) 
1-BA*AL0G(ABS( (2,*Aa*UCEnT*BA-AK)*(BA*AK)/(2.*AA*uCENT.BA.ak)/(BA-A 
2K) ) ) /AK) /UCENT/S/Aa 
GO  TO  140 
120  BA.1.-TJT0 

IF  (ABS(BA) .LT. l.E-10)  GO  TO  130 

DUCDS-2.* ( 1 ,-BA*UCENTl* (BA*UCENT* ALOG ( ABS ( 1 ,-BA*UCENT) ) ) /S/UCENT/B 
1 A/BA 
GO  TO  140 

130  DUCOS—UCENT/S 
140  KEY1»2 
GO  TO  160 

150  YMAX»RFIN»S*HTHETA 
GO  TO  170 
160  YMAX"RFIN*S 
170  CONTINUE 

READ  IN  OR  INTERPOLATE  FOR  THE  GUESSED  VALES  OF  ALPHA 

IF  (NTT.E0.NLIM)  GO  TO  710 
IF  (NTT.EO.O)  GO  To  190 
ALPHAbALPHA«DKDB*DS 

CONVERGENCE  SEARCH  FOR  OAMPEO  SUPERSONIC  WAVE 

IF  (AIMAG(ALPHA) .LT.0.)  GO  TO  180 
IF  <<0MEGA/REAL(ALPHA)).LT.(l./VJA0n  GO  TO  180 

IO*l 
SD-S-DS 
GO  TO  710 
180  ACON(l) -ALPHA 

ACON (2) -CMPLX ( ( 1 ,-PERCR) *REAL ( ALPHA) . < 1 .-PERCI ) *AIHAG (ALPHA) ) 

ACON ( 3) »CMP(.X ( ( 1 . *PERCR) "REAL (ALPHA) ,( 1 . *PERCI ) «A IMAG (ALPHA ) ) 

NT«3 

GO  TO  200 

DETERMINE  THE  STARTING  VALUES  from  tabulation 

190  call  ASTART  (VJAO.sTRNO.TJTO. alpha, NORD.IEROR) 

IF  (IER0R.NE.2)  GO  TO  180 
RETURN 

CALCULATE  STROUHAL  NUMBER  AND  RA01AN  FREOUENCY 

200  STRNObFREO«OFT/VJ 
OMEGA»STRNO»PI 
IF  (IFLG.EO.O)  GO  TO  210 


D1 180 
D1190 
01200 
01210 
01220 
01230 
01240 
01250 
01260 
01270 
01280 
D1290 
01300 
01310 
01320 
D1330 
D1340 
01350 
01360 
01370 
01380 
01390 
01400 
01410 
01420 
01430 
01440 
01450 
01460 
D1470 
01480 
01490 
01500 
01510 
D1S20 
D1530 
01540 
01550 

01560 

01570 

01580 

01590 

01600 

01610 

01620 

01630 

01640 

01650 

01660 

D1670S 

01680 

01690 

01700 

01710 

01720 

01730 

01740 

01750 
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WRITE  (6.740)  NORD, VJAO.TJTO.STRNO. OMEGA, $ 

210  ir  (KEY1.E0.2)  60  f0  220 
IF  (irLG.EQ.O)  60  TO  230 
WRITE  (6,750)  MTMEtA 
60  TO  230 

220  ir  (irLO.EO.O)  60  TO  230 
WRITE  (6,760)  UCENt 

begin  the  integration  and  calculate  the 

STARTING  VECTORS 

230  KK*0 
IFUNC-1 

IF  ( IFLG.EQ. 0)  GO  TO  240 
WRITE  (6,B30)  BETAJ ,BETA2 
240  KK*KK*1 

ALPHAsACON(KK) 

IF  KEY1  ■ 2 THE  STARTING  VECTORS  ARE  OBTAINED  FROM  A 
SERIES  SOLUTION 

250  IF  (KEY1.E0.2)  60  TO  290 

LAM0AM>CS0RT(AL?HA«ALPHA.MACH2*( ALPHA-OMEGA) •( ALPHA-OMEGA) /TJTO) 

DO  260  1*1,3 
260  Y(I)*(0.,0.) 

Y ( 1 ) *CMPLX ( RST , 0 , ) 

ARG*LAMOAM*Y(l) 

PHIbATAN2(AIMAG(ARG) ,REAL(ARG) ) 

IF  (PHI. GT. -PI. AND. PHI, LE. PI/2.)  GO  TO  270 
ARG-ARG- ( 0 • ,-l . ) 

CALL  NCBRTS  (ARG,H01,H02,NORD,0) 
call  NCBRTS  ( ARG » H 1 1 » H 1 2 , NORD 1,0) 

I0*CEXP( (0. , 1 , ) *AN*PI/2, ) *H01 
I 1*CEXP ( ( 0 , • 1 , ) • (AN* I , ) *PI/2. ) *H1 1 
GO  TO  280 

270  ARG»ARG* (0. , 1 . ) 

CALL  NCBRTS  (ARG.HOl , HO 2, NORD, 0) 

CALL  NCBRTS  ( ARG.H) 1 ,H12»N0R01. 0 ) 

I0*CEXP(  (0.,-l.)*Aig*PI/2.)*H01 
1 1*CEXP ( ( 0 . , — 1 . ) * ( AN*1 , ) *PI/2, > *H1 1 
280  Y (2) *10 

Y (3) *AN*I0/Y ( l ) *LAmDAM* I \ 

GO  TO  300 

SERIES  SOLUTION  FOR  THE  STARTING  VECTORS 

290  RHO*l ./ ( 1 .- ( 1 ,-TJTO) *UCENT»0 ,5*GM1*MACH2*UCENT* ( 1 . -UCENT j > 
ORHO*-UCENT*RHO*RHo* ( l . -T JTO-O .5*GMI *MACH2* ( 1 ,-2. -UCENT ) ) 
D2RDR2*2.»DRHO*DRHO/RHO-ORHO*GM1*MACH2*RhO*RHO*UCENT*UCEnT 
DUM>ALPHA*UCENT-OMEGA 
EO*(MACH2*DUM*DUM*rHO-ALPHA*ALPHA) 
E1*(4.*ALPHA*UCENT/DUM-2,*DRH0/RH0)*A/S/S 
E2»MACH2*0UM* (0UM*0RH0-2.*ALPHA*UCENT*RH0) *A/S/S 

E3* (4,*ALPHA*UCENT*0MEGA/0UM/0UM-2,* (02RDR2-DRH0*DRH0/RH0) /RHO) *A* 
1 A/S**4 

A2*- (E0*AN*E1 ) /4 , / (AN* 1 . ) 

A4*-(E2*AN*E3«A2*(eO*(AN*2.)*E1) )/8./(*N*2,) 

Y ( 1 ) *CMPLX ( RST 1,0.) 

Y (2) *Y ( 1 ) ••NORD* ( I . ♦ Y ( I ) *Y ( 1 ) • ( A2« A4«Y ( 1 ) *Y ( 1 ) ) ) 


D1760* 

DITTO 

D170O 

D1790* 

01800 

D1S10 

D1820* 

D1630 

D1840 

01850 

D1860 

D1870 

01880 

01890 

01900* 

01910 

01920 

01930 

01940 

01950 

01960 

01970 

01960 

01990 

02000 

02010 

02020 

02030 

02040 

02050 

D2060S 

D2070S 

02080 

D2090 

02100 

02110 

D2120S 

D2130S 

02140 

02150 

02160 

02170 

02180 

02190 

02200 

D2210 

02220 

02230 

02240 

02250 

02260 

02270 

02280 

02290 

02300 

D2310 

02320 

02330 

02340 


I 
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Yij>»Y(l>**(NORD-l)»(AN.Y(l)«Y(l>»( (AN*2.)*A2*<AN*4.>»A6*Y<1)*Y(I) 
1)  > 

300  M»3 


IF  IFUNC  ■ 1.  EIGENVALUE  IS  BEING  CALCULATED 
IF  IFUNC  ■ 2,  DALPHA/DS  IS  BEING  CALCULATED  FROM  THE 
SOLVABILITY  CONDITION 

IF  ( IFUNC, EQ.l)  GO  TO  320 
IF  <KEY1.EQ.2>  GO  TO  310 
DUMa ALPHA-OMEGA 
HSUM(1,1,1)«(0.,0.) 

HSUM  < 2, 1 . 1 ) *2.« ( ALPHA-MACH2*DUM/T JTO) *Y < 1 ) »Y (2) *Y (2) /OUM/DUM 
ISUM(l,l)«(0,t0.) 

ISUM(2,1)«(ALPHA-MACH2*OUM/TJTO)*Y(1)*Y<1)*(IO*IO-II*I1-2.*AN*IO*I 
1 1 /LAMDAM/Y ( 1 ) ) /OUM/OUM«T JTO 
GO  TO  320 

310  CALL  UEVAL  ( Y ( 1 ) ,UVALi0uVAL,0UDS.D2UDRS»RH0.DRH0,DRDS,D2R0RS> 
DUM»ALPHA*UVAL-OMEGA 

HSUM ( 1 , 1 » 1 ) ■ ( ( (D2RDRS-0RH0*DRDS/RH0> /RM0/RH0*2. ‘ALPHA* (D2UORS-ALPH 
1 A*0UVAL‘0UDS/DUM) /RHO/DUM) *Y  (3) /DUM/0UM-2,‘MACH2‘ <DR6S/RH0*ALPHA‘D 
2U0S/DUM) *Y (2) > *Y (2) *Y ( 1 ) 

HSUM  ( 2 • 1 . 1 ) *2 . « ( ALpHA-MACH2‘DUM*RHO‘UV*L ) *Y ( 1) *Y (2)  ‘Y (2) /DUM/DUM-2 
1 . ‘OMEGA‘DUVAL‘Y (3) *Y ( 2) *Y ( 1 ) /DUM**4/RH0 
JSUM(1,1)»(0..0.) 
lSUM(2,l)a(0.»0.) 

320  INT»0 


DETERMINE  THE  CONTOUR  OF  INTEGRATlON- 
LOCATE  THE  CRITICAL  POINT 


IND-0 

00  330  1*1*3 
330  DIR(I)-(l.t0.) 

OO  340  I *4 1 6 
340  DIR(I)*<-1,.0.) 
cval-omega/alpha 

ETAC«CSORT(-CLOG<CVAL/UCENT)/A) 

IF  (KEY1.E0.2)  GO  TO  350 
RADC«ETAC*S*HTHETA 
GO  TO  360 
350  RAOC«ETAC‘S 

360  IF  (REAL  t RAOC) «GT. (2»*RST1 ) ) GO  TO  370 
RSTl*RSTl/2. 

GO  TO  250 

370  TEMPI aA I MAG (RAOC) *SIGN (ETA2, A IMAG (RADC) > ‘SIGN ( 1 . ,-AIMAG (CVAL) ) 

OECIDE  WHETHER  NECESSARY  TO  INTEGRATE  AROUND 
THE  CRITICAL  POINT 

IF  (ABS(AIMAG(RADC) ) .GT.ETA2«AND.AIMAG(CVAL) .GT.O.)  00  To  380 
DIR (2) »CMPLX(0., SIGN (1.. TEMPI)) 

DIR (5) “0IR (2) 

DEFINE  THE  LIMITS  OF  THE  CONTOU*  INTEGRATION 

LIM ( 1 ) *CMPLX (REAL (RAOC) -ETA1 ,0 . J 
LIM(2) -CMPLX (REAL (RADC) -ETA1, TEMPI) 

LIM(5)»CMPLX (REAL (RAOC) *ETA1, TEMPI) 


02350 

D2360 

02370 

02380 

D2390 

D2400 

D2410 

02420 

02430 

02440 

02450 

02460 

02470 

02480 

D2490 

02500 

02510 

02520S 

02530 

D2540 

02550 

D2560 

02570 

02580 

02590 

02600 

02610 

02620 

02630 

02640 

02650 

02660 

02670 

02680 

02690 

D2700 

02710 

02720 

D2730 

02740 

02750 

02760 

02770 

02780 

02790 

02800 

02810 

D2820 

02830 

D2840 

02850 

02860 

02870 

02880 

02890 

02900 

02910 

02920 

02930 
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LI«  (4)  -CMPLX  (REAL  (rADC)  .ETAl.o.)  029*0 

LIM(3)-CMPLX(REAL(RADC) .TEMPI)  02950 

LIM (6) -LIM (3)  02960 

If  (REAL(LIM(1)).6T.REAL(Y(1)))  60  TO  *00  02970 

LIMU)-Y(l)  02980 

LIM(2)-CMPLX<REAL(Y(1) > ,AIMAG(LIM(2) ) ) 02990 

l f ( If  LG.EQ.  0 ) GO  TO  <*00  03000 

If  dfUNC.EQ.2)  WRITE  (6.8*0)  (LIM ( I ) , I-l ,6)  03010- 

GO  TO  *00  03020 

380  DO  390  1-1.6  03030 

390  LIM(I)-CMPLX(REAL(RADC) ,0.)  030*0 

*00  CONTINUE  03050 

03060 

PERfORM  THE  INTEGRATION  03070 

03080 

IWR-0  03090 

I STEP-1  03100 

CSTEP- ( 0 • . 0 • ) 03110 

INT-0  D3120 

K-l  03130 

N-SMIN-10.  031*0 

IfU-1  03150 

*10  PY(1)-Y(1)  03160 

PY (2) -Y (2)  03170 

PY ( 3) «Y ( 3)  03180 

420  If  (H.LT.SMIN)  H-SmIN  03190 

If  (H.GT.SMAX)  H«Sm*X  D3200 

If  (CABS(Y(l)-LIM(iSTEP) ) .GT.H)  GO  TO  <*30  D3210 

H«CABS(Y(1)-LIM(IStEP) ) 03220 

If  (IfL.EO.l)  IfL-?  D3230 

If  (IfL.E0.3)  If L-*  032*0 

*30  CSTEP-ABS(H)*OIR(IsTEP)  D3250 

CAUL  PJMRUN  (M, CSTeP, Y.DY.P.Q.ERRES)  03260S 

IND-INO. 1 03270 

If  (ERRES.LT. ERMIN)  GO  to  *50  03280 

If  (ERRES.LT. ERMAX)  GO  TO  *60  D3290 

If  (H.LE.SMIN)  GO  TO  <**0  03300 

H-0.8-H  03310 

Y(l)-PY(i)  03320 

YC2)-PY(2)  03330 

Y (3) -PY (3)  033*0 

If  (IfL.EQ.2)  IfL«i  03350 

If  (IfL.EO.*)  If L-3  03360 

GO  TO  *20  03370 

**0  IWR-1  03380 

GO  TO  *60  03390 

450  H-1.25-H  03400 

460  ir  (IfUNC.EO.l)  GO  TO  500  03410 

03420 

CALCULATE  INTEGRALS  TO  fINO  DALPHA/DS  03430 

03440 

CALL  UEVAL  (Y(l) iUvAL. DUVAL. DUDS.02U0RS.RHO.DRHO.0RDS.D2RDRS)  03450S 

DUM-ALPHA-UVAL-OMEGA  03460 

0UM1-Y(1)-Y(2)/DUM/0UM/RH0  03470 

J-2  03480 

If  (INT.E0.1)  J-3  03490 

HSUM ( 1 . J, K ) -DUMi • ( (02RDRS/RH0-DRH0*0RDS/RH0/RH0*2, -ALPHA- (02UDRS/0  03500 

IUM-ALPHA-OUVAL-OUOs/DUM/OUM) )-Y(3)-2.*HACH2-DUM-(0UM-DWs*ALPHA*RH  03510 
20-0U0S) *Y (2) ) 03520 
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HSUM  < 2 * J , K ) »0UM1 *2 . • ( ( A|.PHA-MACH2*DUM«HHo*UVAL > • Y ( 2 > •0ME0A»DUVAL*Y  03530 
1 (3)/0UH/0UM)  03540 

I E (J.EQ.3)  GO  TO  470  03550 

Ll-CSTEP  03560 

IE  (K.E0.2)  LI ■•LI  03570 

INT«1  03560 

GO  TO  500  03590 

470  L2-CSTEP  03600 

IE  (K.EQ.2)  L2--L2  03610 

00  490  J«U2  03620 

00  460  I»1 .3  03630 

460  DUMH ( I ) ■HSUM ( J, I ,K)  03640 

DUM1«ISUM(J,K)  03650 

CALL  INTEG  (DUMH.DuMl *L1 , L2)  03660S 

1 SUM  < J * K ) »DUM  J 03670 

490  HSUM ( J, 1 ,K ) ■HSUM ( J . 3,K ) 03660 

INT-0  03690 

500  GO  TO  (410.510.410,550) , IEL  03700 

510  Y(1)»LIM(ISTEP)  03710 

IE  (IFUNC.EQ.l)  GO  TO  530  03720 

IE  (INT.EO.O)  GO  To  530  03730 

DO  520  1-1.2  03740 

ISUM(I,l)-ISUM(I,l)*0.5*Ll*(HSUM(I,l,l)*HSUM(I.2,l))  03750 

520  HSUM (1,1,1) "HSUM (1,2,1)  03760 

INT»0  D3770 

GO  TO  530  03780 

530  ISTEP»ISTEP*1  03790 

IE  (ISTEP.GT.3)  GO  TO  540  03800 

IE  (CABS(Y(I)-LIM(JSTEP) ) .LT.l.E-10)  GO  TO  510  03810 

IEL-1  03820 

GO  TO  410  03630 

C 03840 

C STORE  EUNCTION  AND  DERIVATIVE  EOR  MATCHING  LATER  03650 

C 03660 

540  PP»Y(2)  03870 

0PP-Y(3)  03880 

GO  TO  5B0  03690 

550  Y ( 1 ) "LlM ( 1STEP)  03900 

IE  (IEUNC.EO.l)  GO  TO  570  03910 

IE  (INT.EO.O)  GO  TO  570  03920 

DO  560  I>1,2  03930 

I SUM (1,2) "ISUM( 1,2) ♦0.5*L1* (HSUM( 1,1,21 *HSUM( 1,2,2))  D3940 

560  HSUM (1,1,2) ■HSUM (1,2,2)  03950 

1NT«0  03960 

570  ISTEP*ISTEP*1  03970 

IE  (ISTEP.GT.6)  GO  TO  600  03980 

IE  (CABS(Y(l)-LIM(ISTEP) ) .LT.l.E-20)  GO  TO  550  03990 

IEL«3  04000 

GO  TO  410  04010 

C 04020 

C STARTING  CONDITIONS  OUTSIDE  THE  JET  04030 

C 04040 

580  Y< 1 ) »CMPLX ( YMAX, 0. ) 04050 

LAMDAPaCSQRT (MACH2»OMEGA*OMEGA-ALPHA*ALPHA)  04060 

IE  <AIMAG(LAMOAP).6T.O.)  GO  TO  590  04070 

LAMDAPa-LAMDAP  04060 

590  ARG«LAMOAP«Y(l)  04090 

CALL  NCBRTS  ( ARG.H01 .H02.NORD, 1 ) 04100S 

CALL  NCBRTS  <ARG,Hjl'H12,N0R0l,l>  04110S 


Y (2) ■HO  1 

06120 

Y(3)*AN*H01/YMAX-LAMDAP*H11 

06130 

IFL-3 

06160 

if  (iruNC.EQ.n  go  to  aio 

06150 

HSUM(l,l,2)-(0.,0.) 

06160 

HSUM (2,1,2) ■2,*ALPhA*Y(1)*Y(2)*Y(2> /OMEGa/OMEGA 

06170 

lSUM(l,2)a(0.,0.) 

06180 

ISUM(2,2)»-ALPHA»Y'(l)*Y(l)*(H01*H0KHU*Mll-2,»AN«H0i»Hll/LAMOAP/Y 

06190 

1(1)) /OMEGA/OMEGA 

06200 

INT-0 

06210 

K>2 

06220 

GO  TO  610 

D6230 

c 

06260 

c 

DETERMINE  function  to  be  minimised  to  determine  eigenvalue 

06250 

c 

06260 

600 

BB6»Y (3) *PP-Y (2) *DpP 

D6270 

AC«Y(2)/PP 

06280 

IF  (IFUNC.EQ.l)  GO  TO  620 

06290 

IF  (IFLG.EQ.O)  GO  TO  610 

06300 

WRITE  (6, BIO)  AC 

06310* 

c 

06320 

c 

calculate  dalpha/ds 

06330 

c 

D6360 

610 

ISUM(1,1)»AC*AC*ISUM(1,1) *ISUM(I,2) 

06350 

ISUM (2, I ) *AC*AC*I SuM (2, I ) ♦ I SUM (2,2) 

06360 

OKOB— I SUM  (1,1) /I SUM  (2,1) 

06370 

IF  (IFLG.EQ.O)  GO  TO  10 

06380 

WRITE  (6,620)  DK08 

06390* 

GO  TO  10 

06600 

620 

BB (KK) «BB6 

D6610 

IF  (IFLG.EQ.O)  GO  TO  630 

D6620 

WRITE  (6,770)  IND, ACON ( KK) ,BB (KK) 

06630* 

630 

IF  (KK.LT. NT)  GO  TO  260 

06660 

c 

06650 

c 

FIND  NEXT  GUESS  FOR  ALPHA 

06660 

c 

06670 

CALL  LAGRAN  (KK.ACON, alpha, BB) 

06680$ 

IF  (NTT.EO.O)  ALPHA"CMPLX(REAL(ALPHA),-ABS(AIMAG(ALPHA))J 

06690 

ACON ( KK  « 1 ) "ALPHA 

06500 

IF  (ABS(REAL(AC0N(KK«l)n.LT.l.E-5)  GO  TO  660 

06510 

IF  ( ABS( 1 ,»REAL (ACON(KK) ) /REAL (ACONIKK+i ) )) ,GT .0.005)  GO  TO  680 

06520 

GO  TO  650 

D6530 

660 

WRITE  (6,850) 

06560* 

650 

IF  <ABS(AIMAG(AC0N(KK*l))),LT.l.E-5)  GO  TO  660 

06550 

IF  (ABS(1,»AIMAG(AC0N(KK))/AIMAG(AC0N(KK*1))),GT. 0,005)  GO  TO  680 

06560 

GO  TO  670 

06570 

660 

WRITE  (6,860) 

06580* 

GO  TO  690 

06590 

670 

CONTINUE 

06600 

GO  TO  690 

06610 

660 

IF  (KK.LT. 15)  GO  TO  2*0 

06620 

IEROR-l 

06630 

RETURN 

06660 

690 

IF  (IFLG.EQ.O)  GO  TO  700 

06650 

WRITE  (6,780)  ALPHA 

06660* 

700 

NTT-NTT*! 

06670 

ADAT (NTT) -ALPHA 

06680 

SDAT (NTT) -S 

06690 

COAT (NTT) -AC 

06700 
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IFUNC"?  0*710 

00  TO  2*0  0*720 

710  CONTINUE  0*730 

IF  (JFLG.EO.O)  GO  TO  730  0*7*0 

WRITE  (6,790)  VJAO  0*750* 

DO  720  1»1»NTT  0*760 

720  WRITE  (6, BOO)  SOAT(I) • AQAT ( I ) ,CDAT(I)  0*770* 

730  CONTINUE  0*780 

CALL  OIRECT  (ADAT, NTT. DS»TM, NANG, BO. GAMMA, INF. RADNF,XL*ST,RSTART,P  0*790* 
1TNETA.PDB)  0*800 

RETURN  0*810 

0*820 

7*0  FORMAT  ( 1H1 , 1 OX, "INVI SClD  AXISYMMETRIC  JET  STABILITY  CALCULATION"/  0*830 
1 l ix,"*************»*********************************"F?22X»"M0DE  N 0*8*0 

2UMBER  ■ « • I 1//22X*"MACH  NUMBER  ■ «»F10.*//22X, "TEMPERATURE  RATIO  ■ 0*850 

3 "»F10.*//22X,"STROUHAL  NUMBER  ■ "»F10«*//22X,"FRE0U£nCy  » »,F10,*  0*860 

*//22X. "THICKNESS  ■ ".Flo.*//)  0*8TO 

750  FORMAT  (22X, "POTENTIAL  CORE  RADIUS  ■ "»FlO,*//>  0*880 

T60  FORMAT  (22X,"JET  CENTERLINE  VELOCITY  • ",F10.*//)  0*890 

770  FORMAT  < 1 Xt 15. *X. "ALPHA  » ".2E1 1 .5«2X,"GI VES  B*  ■ ",2Ell.5/l  0*900 

780  FORMAT  (21X, "WAVENUMBER  ■ ",2F1*,9//)  0*910 

790  FORMAT  < 1H1 , 30X,«M*CHNO  « »,F10.*///3Xt"THICKNESS", 1 5X» "ALPHA »,25X  D*920 

1»"C"//)  0*930 

800  FORMAT  <lX,E11.5»*<2En,5>)  0*9*0 

810  FORMAT  (30X»"C  • »,2F1*,9/)  0*950 

820  FORMAT  (25X, "OK/OS  ■ ".2E12.5//I  0*960 

830  FORMAT  (1X.«BETA1  ■ » »F 1 0.5,5X,"BETA2  ■ "»F10.5//)  0*970 

8*0  FORMAT  ( IX,* (1 X, ZEl*,7) ) 0*980 

850  FORMAT  (IX, "REAL  PART  OF  ALPHA  TOO  SMALL  FOR  CONVERGENCE  TEST"/)  0*990 

860  FORMAT  ( 1 X , "IMAGINARY  PART  OF  ALPHA  TOO  SMALL  FOR  CONVERGENCE  "t"T  05000 

1EST,  ITERATIONS  COMPLETED"//)  05010 

END  05020* 
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•DECK  PJW9UN 

SUBROUTINE  PJMRUN  (M,H«YtOY*P,Q«ERRESl 
COMPLEX  Y(M) ,DY<M) ,P(M) ,0(M) ,RR<«) tH 
DO  10  1*1 |M 
10  Qlll'IO.iO.I 
DY(1)*<1.,0.) 

DO  20  I*2»M 
20  DY(I)*(0.t0.) 

CALL  OERY  <M,Y»DY) 

DO  30  1*1 *M 
P(I)*M*DY(I)*0«5 
RR(I)*(P<I)-Q(I)*Y(I) )-Y(I) 

Y(I)*Y(I) *RR ( 1 ) 

30  0(I)*(3.*0(I))>P(I)*(3.*RR(I)) 

CALL  OERY  (M.YtOY) 

00  40  1*1, M 
P ( I ) *H*OY < I ) 

RR(I)*I(P(I)-0(I))*0.5*Y(I))-VII) 
Y(I)*Y(I) *RR  < I ) 

40  0(i)*(3.*P(in-(2.*0(in>(6,*RR(n) 

CALL  OERY  (M.Y.OY) 

ERRES-0. 

00  60  I*1»M 

IF  (CABS(P(I)-0(I)).LT.1,E-20)  00  TO  SO 
E*CABS ( { (H*OY ( I ) ) -P ( I ) ) / (P ( I ) -0 ( I ) ) ) 

IF  (E.GT.ERRES)  ERRES-E 
50  P<I)*H*OY<I)-0.5*PiI) 

RR(I)*(P(1)«Y(1) )-y(I) 

Y ( I ) *Y ( I ) *RR ( I ) 

60  Q<n*0(I>»6.«(P(I).RR(I)> 

CALL  OERY  (M.Y.OY) 

DO  70  1*1. M 

P( I ) * (“4.»P( I > *H*DY ( I ) *Q( I ) ) /6. 
RR(I)*(P(I)*Y(I) )-Y(I) 

Y < I ) *Y ( I ) *RR ( I ) 

70  Q(n*RR(I)-P(I) 

RETURN 


E 10 
E 20 
E 30 
E 40 
E SO 
E 40 
E TO 
E BOS 
E *0 
E 100 

e no 

E 120 
E 130 
E 140S 
E ISO 
E 1*0 
E 170 
E 1*0 
E 1*0 
E 200* 
E 210 
E 220 
E 230 
E 240 
E 250 
E 260 
E 270 
E 2*0 
E 290 
E 300* 
E 310 
E 320 
E 330 
E 340 
E 3S0 
E 360 


•DECK  DERY 

SUBROUTINE  OERY  (M.Y.OY)  f 10 

COMPLEX  Y(M)»OY(M)fALPMA(UVAL«OUVAL*RHOtORHO  F 20 

COMPLEX  DUDS • D2UDrS • OROS 1 02RDRS • OUM  F 30 

COMPLEX  OKOB  F AO 

REAL  MACH2  F 50 

COMMON/ 1 NF 0/ ALPHA ( OMEGA  « MACH? » T JTO  * NORU  # GM1 » DKDB  » IFLG  » V JAO  F 60 

C0MM0N/SPR/HTHETA#S,KEY1,UCENT,DUCDS.B£tA1,BETA2,IFUNC  F TO 

ANbNORD  F 80 

CALL  UEVAL  (Y(l) tUvALtDUVAL»DUDSiD2UDRStRH0*DRH0»DR0St02R0RS)  F 90S 

DUMa  ALPHA  *UV  AL  -OME  6 A F 100 

OY (2)"Y (3)  F 110 

DY (3» ■ (DRH0/RH0*2.*ALPHA*DUVAL/DUM-1 ,/Y ( 1 ) ) «Y (3) ♦ < AlPHA«ALPHA-MACH  F 120 
12*DUM*DUM*RHO*ANaAN/Y ( 1 ) /Y { 1 ) ) «Y (2)  F 130 

RETURN  F 1A0 

END  F 150- 
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•DECK  UEvAL 

SUBROUTINE  UEVAL  <X»UtDUDR.0U0S,D2UDRS*R»DR0R,DRDS,D2R0RS)  0 10 

COMPLEX  X • U • OUOR * DUDS • 02UORS * R » OROR • DRDS , 02RDRS  C 20 

COMPLEX  ALPHA, ET A ,DROU,D2RDU2  G 30 

COMPLEX  DK0B,02U0R2  G 40 

REAL  MACH2  G SO 

COMMON/ INFO/ALPHA, OMEGA, HACH2,TJTO«NORD«GM1 ,DKDB« IFLG, VJAO  G 60 

COMMON/SPR/HTHETA,S,KEYl «UCENT«DUCDS,BEtA1 «BETA2« IFUNC  G 70 

A«, 693147  G 80 

GO  TO  (10,40,60,60),  KEY1  G 90 

6 100 

IF  KEY1  ■ 1 WE  CALCULATE  UVAL  IN  THE  ANNULAR  MIXING  G 110 

REGION  FOR  A GIVEN  VALUE  OF  RADIUS,  X.  G 120 

G 130 

10  IF  (REAL(X).LT.HTHETA)  GO  TO  70  G 140 

ETA«(X-HTHETA)/S  G 150 

U"CEXP(»A*ETA«ETA)  G 160 

DUDR«-2,*A»ETA«U/S  G 170 

20  R»1,/(1,*(TJT0-1,)*U*0,5»GM1«MACM2*U«(1,-U))  G 180 

IF  (KEY1.EQ.3)  GO  TO  80  G 190 

DRDU»»R*R* (TJT0"»1«*0»S*GM1*MACH2* (1 »«2»*U) ) G 200 

ORORaDRDU*DUOR  G 210 

IF  (IFUNC.EO.l)  GO  TO  80  G 220 

D2UOR2* (4,»A»A*ETA»ETA«2,#A) *U/S/S  G 230 

IF  (KEYl.EO.2)  GO  TO  SO  G 240 

DHOS«-TJTO*(HTHETA*BETAi,2.*BETA2*S)/<HThETA»TJTO*BETA1»S)  G 250 

OUOS»OUOR*(ETA*DHDS)  G 260 

D2U0RS—D2U0R2*(ETa»DH0S)*0UDR/S  G 270 

30  OROS«ORDU*OUOS  G 280 

02R0U2a2.*0R0U*0R0u/R*GMl«MACH2«R*R  G 290 

02RDRSBD2RDU2*OUOR*DUOS»ORDU*D2UORS  G 300 

RETURN  G 310 

G 320 

IF  KEY1  ■ 2 WE  CALCULATE  UVAL  IN  THE  OEVELOPEO  JET  G 330 

FLOW  FOR  A GIVEN  VALUE  OF  RAOIUSi  X,  G 340 

G 350 

40  ETAaX/S  G 360 

U«UCENT*CEXP(-A*ETA«ETA)  G 370 

OUOR*-2.«A«ETA*U/S  G 380 

GO  TO  20  G 390 

SO  DUOSaOUCDS*U/UCENT.ETA«OUDR  G 400 

D2UORSa(OUCOS/UCENt>l*/S)aOUDR-ETA*D2UOR2  G 410 

GO  TO  30  G 420 

G 430 

IF  KEY1  a 3 WE  CALCULATE  THE  VALUE  OF  UVAL  FO*  A GIVEN  G 440 

VALUE  OF  ETAaX.  G 450 

G 460 

60  ETAaX  G 470 

UaCEXP(-A*ETA»ETA)  G 480 

0UDRa-2,aAaETA«U  G 490 

IF  (KEY1.E0.4)  GO  TO  90  G S00 

GO  TO  20  G 510 

70  Ua(l.,0.)  G 520 

DUORa ( 0 , , 0 * ) G 530 

Ral./TJTO  G 540 

ORDRa (0, ,0, ) G 550 

80  OUDSa(0.,0.)  G 560 

D2UORSa(0,,0.)  G 570 

DROSa (0, ,0,)  G 580 

02RORSa(0.,0.)  G 590 

RETURN  G 600 

90  Ral,/(l,*(TJT0-l.)aUaUCENT*0.5*GMl*MACM2au*UCENT*(l,-U«UCENT)>  G 610 

RETURN  G 620 

END  G 630- 


•DECK  LAGRAN 

SUBROUTINE  LAGRAN  (NUM,CtCVAL»B4> 
COMPLEX  CUO)  .B4(10>  ,CVAL*CONT#CMIN 
00  20  JJ-1.2 
N-NUM.JJ 
CMIN«B4 (N) 

JN»N 

DO  10  I»i.N 
K»NUM-I-JJ*1 

IF  (CABS(CMIN) ,lE.CABS(B4(K) ) ) GO  TO  10 
JN»K 

CMIN*B4 (K) 

10  CONTINUE 

IF  (JN.EQ.N)  GO  TO  20 
84 ( JN) «84 (N) 

B4 (N) aCMIN 
CMIN»C(N) 

C (N) »C ( JN) 

C ( JN) aCMIN 
20  CONTINUE 
CVAL" (0 . * 0 , ) 

DO  40  J»N,NUM 
CONT» ( 1 . *0. ) 

00  30  I-N.NUM 
IF  (I.EQ.J)  GO  TO  30 
CONT-CONT* (84 ( I ) / (84 ( J) -84 ( I ) ) ) 

30  CONTINUE 

40  CVAL«CVAL*C(J)«CONT 
RETURN 
ENO 


H 180 
H 190 
H 200 


H 210 
H 220 
H 230 
H 240 
H 2S0 


H 260 


H 2T0 


H 280 


H 290- 


■ 
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•DECK  NCBRT* 

SUBROUTINE  NCBRTS  (Z«B1 (B2«N«M) 
COMPLEX  ZtHl (SO) tMj(50) *B1»B2 
IF  (M.EQ.O)  00  TO  20 
IF  (N.EQ.O.OR.N.EQ.l)  00  TO  20 
call  cbrts  (Z.Hun,H2U).o,n 
CALL  CBRTS  (Z«H1 (2) (H2(2) (1*1) 
NR1»N*1 
DO  10  JO.NR1 

Hi  ( J-2l»Nl  (J-K/Z-Hl  ( J-2) 
10  M2(JJ»2.»<J-Z)»H2(J-l)/Z-M2U-2> 
SI»H1(NR1) 

B2«H2(NP1) 

RETURN 

20  CALL  CBRTS  JZtBl «B2»N»M) 

RETURN 


1 10 
X 20 
I 30 
1 *0 
1 SOS 
I 60S 
I TO 
I 00 
1 90 

I 100 
i no 
1 120 
I 130 
I 1*0$ 
I ISO 


•DECK  CERTS 


SUBROUTINE  CBRTS  <Z.Hl ,H2,N,H) 

OIMCNSION  AJ(IOOO) 

COMPLEX  Z.C0NtF2,SUM,AJN.AYN#FCT.FCD.Hl »H2 
AN-N 

R>CABS(Z) 

IF  (R.GT.6.6)  GO  To  60 
IF  (R.GE. .IE-30)  Go  TO  10 
THETA-0. 

GO  TO  20 

10  THCTA>ATAN2(AIMAG(Z) *REAL(Z) ) 

20  CONTINUE 
THN-AN* THETA 

CONaCMPLX (COS « THN) ,SIN<THN) ) 

Fl»-I, 

F2»CMPLX( (C0S(2.*THETA)-l.) ,SIN(2.*THETA) ) 
F3-R/2. 

FAC-I. 

LIM»29-N 

CALL  BSSLS  (RtAJ,29,lERR) 

SUM»CMPLX(AJ(N*1) ,0.) 

FCO«Fl»F2*F3 

FCT«(1..0.) 

DO  30  Kal.LIM 
L"N*K*1 
FAC«K*FAC 
FCT»FCT»FCO 
AJ(L)»AJ(L)/FAC 
30  SUM>SUM*FCT«AJ(L> 

IN»LlM*l 
KN>LIM«U 
DO  40  I»IN»KN 
FAC»I*FAC 
L"I*N 

CALL  BELS  (Rt Y*L) 

FCT»FCT«FCO 

Y»Y/FAC 

40  SUM»SUM»FCT*Y 
AJN>CON*SUM 

CALL  BELZ  (Z.AJN.AyN.N) 

IF  (M.NE.O)  GO  TO  50 

HlaAJN 

M2»AYN 

RETURN 

50  H1»AJN« ( 0 , • 1 • ) *AYN 
H2«AJN-J0.,1.)»AYN 
RETURN 
60  CONTINUE 

CALL  HAN  (ZtHl.H2.N) 

IF  <M.NE.0>  GO  TO  70 
HI«(Hl*H2)/2. 

H2»(0..-.5)«(Hi-H2) 

TO  RETURN 
ENO 


J 310 
J 320 
J 330 
J 340S 
J 350 
J 360 
J 370 
J 380 
J 390  S 
J 400 
J 410 
J 420 
J 430 
J 440 
J 450 
J 460 
J 470 
J 4B0S 
J 490 
J 500 
J 510 
J 520 
J 530- 


► 
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•DECK 

BSSIS 

SUBROUTINE  BSSLS  <X»F.N,IERR> 

K 

10 

DIMENSION  F (1) 

K 

20 

IERR-0 

K 

30 

NMAX-30 

K 

AO 

IF  (N.IE.NMAX)  60  TO  10 

K 

50 

IERR-1 

K 

60 

RETURN 

K 

70 

10 

MX-X 

K 

80 

NPP»3*MX*12*10*(IABS(N-l)/10) 

K 

90 

IF  (IFIX(X) ,6T.N)  nPP*IFIX(3.*X*12.) 

K 

100 

IF  (M00(NPP,2) .EQ.O)  NPP«NPP*1 

K 

no 

00  20  I-l.NPP 

K 

120 

20 

F < I > -0, 

K 

130 

IF  (X.GE..1E-3A)  GO  TO  30 

K 

1 AO 

F ( 1 ) ■ 1 • 

K 

150 

RETURN 

K 

160 

30 

IF  (X.GE..14E0)  GO  TO  80 

K 

170 

Z-X/2. 

K 

180 

F (1 ) *1  • 

K 

190 

LPP-NPP-1 

K 

200 

DO  AO  K-l.LPP 

K 

210 

*0 

F(K*1)»F(K)«Z 

K 

220 

FAC2»-Z»Z 

K 

230 

FAC1-1. 

K 

2A0 

DO  70  I-l.NPP 

K 

250 

NORD-I-1 

K 

260 

IF  ( I ,EO, 1 ) GO  TO  SO 

K 

270 

FAC1-FAC1/FLOATINORD) 

K 

280 

50 

val-faci 

K 

290 

SUM»FAC1 

K 

300 

DO  60  J-2.20 

K 

310 

L-J.NORD-1 

K 

320 

K-J-l 

K 

330 

VAL»VAL«FAC2/FL0AT(L*K) 

K 

3A0 

IF  (ABS(VAL) .LT.l.E-20)  GO  TO  70 

K 

350 

60 

SUM-SUM. VAL 

K 

360 

70 

F(I)»F(I)*SUM 

K 

370 

RETURN 

K 

380 

SO 

NP-NPP.l 

K 

390 

NPR-NPP-1 

K 

A00 

F(NP-1)«.1E-3A 

K 

A10 

F(NP)«0. 

K 

A20 

00  90  I-l.NPR 

K 

A30 

NP-NPP-I 

K 

AAO 

XN-NP 

K 

A50 

90 

F (NP) »2.»XN/X*F (NP.l ) -F (NP»2) 

K 

A60 

XN-F  ( 1 ) 

K 

A70 

DO  100  I-3.NPP.2 

K 

A80 

100 

XN«2.*F  < I ) *XN 

K 

A90 

XN-l./XN 

K 

500 

DO  110  I-l.NPP 

K 

510 

F(I)-XN*F(I) 

K 

520 

110 

CONTINUE 

K 

530 

RETURN 

K 

5A0 

END 

K 

550- 

30 
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•DECK  BEIS 

SUBROUTINE  BELS  (X.Y.N) 

AN*N 

FN*l. 

00  10  1*1 *N 
*1*1 

10  FN*FN*AI 
C*  < ,5*X) **2 
CN* ( ,5*X) **N/FN 
F*C/(AN*1.) 

AJ-2. 

0*1. 

FN1-1.-F 

20  F*F*C/( (AN*AJ)*AJ) 

FN1*FN1*0*F 

AJ*AJ*1. 

D»-0 

IF  (ABS(F/FN1I-1.E-10>  30t30t20 
30  Y*FN1*CN 
RETURN 
END 
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•DECK  BELZ 

SUBROUTINE  BELZ  (X.V.XY.N)  M 10 

COMPLEX  X,Y*XY*SM.CXF.CCN,CC,CF,CFN1,CFN3*CHA,XI  M 20 

CHA«(.5,0,I  M 30 

AN»N  M 40 

IF  (CABS(X) .GE..1E-30)  GO  TO  10  M SO 

PH-O.  M 60 

GO  TO  20  M 70 

10  PH-ATAN2(AIMAG(X).REAL(X)|  M BO 

20  CONTINUE  M 90 

XI-<0.»1.)  M 100 

R>CABS(X)  M 110 

FN-1.  M 120 

FH-O.  M 130 

F0»0»  M UO 

SM» ( 0. • 0 • ) M ISO 

IF  (N)  30,60.30  M 160 

30  00  40  I«1,N  M 170 

A I • I M 180 

FM-FM.l./AI  M 190 

40  FN-FN-AI  M 200 

CXF-CHA«CHA»X*X  M 210 

CCN-(CHA*X)**(-N)/FN  M 220 

FS-FN/AN  M 230 

GS-1.  M 240 

00  50  1-1 »N  M 250 

Al-I  M 260 

SM-SM.CCN-FS/GS  M 270 

CCN»CCN*CXF  M 280 

GS-GS*AI  M 290 

IF  (N.EO.I)  GO  TO  50  M 300 

FS-FS/<AN-AI)  M 310 

50  CONTINUE  M 320 

60  CC-CHA*CHA*X*X  M 330 

CCN- (CHA*X) **N  M 340 

CCN-CCN/FN  H 350 

CF>CC/(AN«1.)  M 360 

AJ-2.  M 370 

0-1.  M 380 

CFN1-1.-CF  M 390 

CFN3-CMPLX(FM,0.)  M 400 

FO-FO*l./(AJ-l.)  M 410 

FM-FM*1 ,/(AN*AJ-l,)  M 420 

rP-FH*FO  M 430 

CFN3«CFN3-CF»FP  M 440 

70  CF«CF*CC/( <AN*AJ)**J)  M 450 

CFN1»CFN1*0*CF  M 460 

FO»FO*l ,/AJ  H 470 

FH-FM* 1,/(AN»AJ)  M 480 

FP>FM*FQ  M 490 

CFN3«CFN3*D<*CF»FP  M S00 

AJ-AJ.l,  M 510 

0—0  M 520 

IF  (CABS (CF/CFN1 ) -1 ,E*10)  80.80, 70  M 530 

80  XY-<2.*(,5772156649*(AL0G(R/2.)*XI«PH)»*Y-SM-CFN3*CCN)/3, 141592653  M 540 

159  M 550 

RETURN  M 560 

END  M 570- 


32 


•DECK  HAN 

SUBROUTINE  HAN  <Z.Hl,H2,NJ 
COMPLEX  Z,H1 ,H2, SEtl * SP, X, CP, CPI 
P I »3« 1*159265359 
AN»N 

IF  (CABS(Z) .6E..1E-30)  60  TO  10 
PH-O. 

60  TO  20 

10  PH>ATAN2(AIHA6(Z) tREAL(Z) > 

20  CONTINUE 
R>CABS(Z) 

S1-EXP(-1.»AIMA6(Z) >/SQRTI.5*PI»R> 
SI6MA1»2.*REAUZ)  /PI-AN-.5-PH/PI 
SETI«CEXP(.5*C0,.1.)*PI*SI6MA1) 
SP«(1.*0.) 

CP-SP 

CP1-CP 

X— 2.«Z*<0.,1.) 

Cl«l. 

30  CP»CP«<4.»AN*AN-C1*C1)/(C1*4.»X) 
C1»C1*2. 

SP»SP*CP 

IF  <CABS<CP)-CABS(CP1> > *0,50,50 
40  CPl-CP 
60  TO  30 
50  SP-SP-CP 

H1«S1*SETI*SP 

S1«EXP(AIMA6<Z) )/S0RT(.5*PI*R) 
SI6MA1»-2.*REAL(Z)/PI*AN*,5-PH/PI 
SETI-CEXP ( .5* (0. , 1 . ) *PI»SI6HA1 ) 
SP«<1.,0.) 

X*2.*Z* (0. « 1 . ) 

CP»SP 
CPl-CP 
Cl«l . 

60  CP-CP*  <*,«AN*AN-C1*CI > / (C1«4,«X) 
C1»C1*2. 

SP-SP*CP 

IF  (CABS(CP)'CABS(CPin  TO, 80, 80 
TO  CP1-CP 
60  TO  60 
80  SP-SP-CP 

H2»S1*SETI*SP 

RETURN 

ENO 


N 10 
N 20 
N 30 
N 40 
N 50 
N 60 
N TO 
N 80 
N 90 
N 100 
N 110 
N 120 
N 130 
N 140 
N 150 
N 160 
N 170 
N 180 
N 190 
N 200 
N 210 
N 220 
N 230 
N 240 
N 250 
N 260 
N 2T0 
N 280 
N 290 
N 300 
N 310 
N 320 
N 330 
N 3*0 
N 350 
N 360 
N 3T0 
N 380 
N 390 
N *00 
N *10 
N *20 
N *30 
N **0- 
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•DECK  DIRECT 

SUBROUTINE  DIRECT  (ADAT »NTT .DB.TM.NANG.Bo. GAMMA. INF .RADNF .XL AST »RS 
1TART  *?7HETA»PDB) 

DIMENSION  TM(NANG) .PTHETA (NANG) ,POB<NANG) 

COMPLEX  Y (A) »DY (4> ,P(4) ,Q<4) ,XSAVE,PY(A) 

COMPLEX  ALPHA,DKOBtADAT(l) .AVAL.DUM 

COMPLEX  XVAL  ( 1025)  .WU025)  ,W1  (1025)  ,BN<1025)  .CWAVE.CONT 
COMPLEX  H01.H02 
REAL  NFDB(1025.10) 

INTEGER  GAMMA 

REAL  MJ.MACH2. KAPPA, M20 

common/oata/kappa.epsi.potb.iflag 

COMMON/INFO/ALPHA, OMEGA, MACH2.TJTO.NORO,GMI»DKDB,IFLG*VJAO 
ERMIN-0.1 
ERMAXaO, 14 
PI«3. 14159 
FCT-57.2958 
MJ»VJA0/S0RT (TJTO) 

IF  (MJ.GT.2.)  GO  TO  10 
SIGMA«10.T/(1.-,1163»MJ*MJ) 

GO  TO  20 

10  SIGMA>19.4*SQRT(MJ.0,9418) 

20  EPSI«1. 2658/SIGMA 
OELX-0. 5/OMEGA 
IF  (IFLG.EQ.0)  GO  TO  30 

WRITE  (6,680)  NORD.VJAO, TJTO. EPSI , GAMMA 

CALCULATION  OF  WIDTH  AT  END  OF  POTENTIAL  CORE 

30  M20*MACH2»OMEGA*OMeGA 
A"0«2*MACH2 
B»(1.-TJT0-A) 

IF  (A.LT.l.E-10)  GO  TO  40 
AK»SORT<B*B*4.*A) 

P0TB«-1.38629*A/(AL0G(ABS(A*B-1.) )-B»ALOG(ABS( (2,»A*B-AK) • (B*AK) / ( 
12.»A*B*AK)/(B-AK) »j/AK)/TJT0 
POTB-SQRT(POTB) 

GO  TO  60 

40  IF  (ABS(8>,LT.1.E-10)  GO  TO  50 

P0TB«-.693147*B*B/(B*AL0G(ABS(1.-B) ) )/TJT0 
POTB*SQRT (POTB) 

GO  TO  70 


P 10 
P 20 
P 30 
P 40 
P 50 
P 60 
P 70 
P 80 
P 90 
P 100 
P 110 
P 120 
P 130 
P 140 
P 150 
P 160 
P 170 
P 180 
P 190 
P 200 
P 210 
P 220 
P 230 
P 240 
P 250* 
P 260 
P 270 
P 280 
P 290 
P 300 
P 310 
P 320 
P 330 
P 340 
P 350 
P 360 
P 370 
P 380 
P 390 
P 400 
P 410 


50  POTB-1, 17741  P 420 

GO  TO  80  P 430 

P 440 

CALCULATION  OF  THE  EOOY  VISCOSITY  CONSTANT  P 450 

P 460 

60  RHOB«1./(1,-0.5*B-0.25«A)  P 470 

KAPPA* ( 1 ,/A-.<  (B*A)*ALOG(ABS(A.B-l,) >-{B*B*2.*A*A*B>*AL0G(ABS( (2,*A  P 480 

1*B>AK)*(B»AK)/(2,«A«B*AK)/(B-AK) ) )/AK)/2,/A/A)*2.88539/Rh0B  P 490 

GO  TO  90  P 500 

70  RHOB«1./(1.-0.5«B)  P 510 

KAPPA»(0.5«TJTO*AL06(TJTO)/B/B)*2.88539/B/RHOB  P 520 

GO  TO  90  P 530 

80  KAPPA-POTB/2. 07944  P 540 

90  IFLAG-1  P 550 

P 560 

CALCULATION  OF  STARTING  CONDITIONS  P 570 

P 580 


r 


Y ( 1 ) - (0. *0. ) P S90 

V (2) “BO  P 600 

Y(3>»(1.*0.>  P 610 

Y(4)a(l,t0,)  P 620 

B-REAL(Y(2>)  P 630 

UCaREAL ( Y (3) ) P 660 

X»REAL<Y(1) ) p 650 

DBDX*EPSI  P 660 

C P 670 

C CALCULATE  INTEGRAND  FOR  FOURIER  TRANSFORM  P 680 

C P 690 

XVAL ( 1 ) »Y (4)  P TOO 

IF  (NORD.EO.O)  GO  TO  110  P 710 

CALL  COEFF  (ADAT*NfT»B*AVAL»OB)  P 720* 

DUM»CSQRT(MACH2«0MeGA*0MEGA.AvAL*AVAL>  P 730 

IF  (AIMAG(DUM) .GT.O.)  GO  TO  100  P 740 

DUM»-DUM  p 750 

100  DUM«DUM#*NORD  P 760 

XVAL(1)«XVAL(1)/DUM  P 770 

110  CONTINUE  P 760 

AMPaCABS ( XVAL ( 1 ) ) P 790 

IF  (ABS(AIMAG(XVAL(i»)».LT.l.E-20)  GO  TO  120  P 600 

IF  (ABS(REAL(XVAL(l>)).LT.l.E-20)  GO  TO  130  P 610 

PHASEaATAN2(AIMAG(XVAL(l) ) t REAL < XVAL ( 1 > ) )»FCT  P 620 

GO  TO  140  P 630 

120  PHASEaO.  P 640 

130  PHASEa90.*SIGN(l.tAIMAG(XVAL(l)))  P 650 

140  IF  (IFLG.EO.O)  GO  TO  150  P 660 

WRITE  (6*690)  X*B*DBDX*UC. XVAL ( 1 ) .AMP, PHASE  P 870* 

C P 860 

C BEGIN  INTEGRATION  P 690 

C P 900 

150  N«2**GAMMA  P 910 

ISTEPal  P 920 

HaOELX  P 930 

SMAXaH  P 940 

SMINaH/1000.  P 950 

XSAVEaV(l)  P 960 

160  IFL-1  P 970 

XSTOPaREAL (XSAVE) *DELx  P 980 

ISTEPaISTEP«l  P 990 

IF  (ISTEP.GE. CN*2) ) GO  TO  310  P1000 

170  DO  160  I»1 *4  P1010 

160  PY ( I ) ■ Y ( I ) PI 020 

190  IF  (H.LT.SMIN)  HaSMlN  P1030 

IF  (H.GT.SMAX)  HaSMAX  P1040 

IF  (CABS(Y(l)-XSTOP) .GT.H)  GO  TO  200  P1050 

HaCABS ( Y ( 1 ) -XSTOP)  P1060 

IFL-2  P1070 

200  CALL  RUNREL  (4*H* Y,DY* P*0*ERRES* ADATtNTT *DB1  P10B0S 

INDalNOM  PI  090 

IF  (ERRES.LT. ERMIN)  GO  TO  230  P1100 

IF  (ERRES.LT. ERMAX)  GO  TO  240  PI  110 

IF  (H.LE.SMIN)  GO  TO  220  P1120 

H«0  »8*H  PI  130 

DO  210  Ial,4  PI  160 

210  Y(I)aPY(I)  PI  150 

IFL-l  PI  160 

GO  TO  190  PI  170 


220  IWR-1  PI  180 

SO  TO  ?40  PI 190 

230  M»1.25*H  P1200 

240  IF  (IFL.EQ.l)  00  TO  170  P1210 

X»REAL(Y(1))  PI  220 

B*REAL  < V ( 2) ) P1230 

UCaREAL (V(3) ) P12A0 

0BDX*REAL(DY(2))  P12S0 

C P1260 

C CALCULATE  INTEGRAND  FOR  FOURIER  TRANSFORM  PI 270 

C P12S0 

XVAL ( ISTEP) »Y (4)  P1290 

IF  (NORO.EO.O)  GO  TO  260  P1300 

CALL  COEFF  (ADAT.NfT.B. AVAL.OB)  P1310S 

DUM-CSQRT (MACH2*0ME6A*0ME6A. AVAL* AVAL)  PI 320 

IF  (AIMAG(OUM) .GT.O.)  GO  TO  2S0  P1330 

DUMa.OUM  PI  340 

250  DUMaCSQRT(DUM)  P13S0 

XVAL  (ISTEP) «XVAL (IsTEP) /DUM  PI  360 

260  CONTINUE  P1370 

AMPaCABS (XVAL ( ISTEP) > P1380 

IF  (ABS(AIMAG(XVAL(ISTEP))).LT.l.E-20)  GO  TO  270  P1390 

IF  (ABS(REAL(XVAL(lSTEP))).LT.l.E-20)  GO  TO  2B0  P1400 

PHASE-ATAN2 ( AIMAG ( XVAL  < I STEP) ) .REAL (XVAL (ISTEP) > ) *FCT  P1410 

GO  TO  290  P1420 

270  PHASEaO.  P1430 

GO  TO  290  P1440 

280  PHASE-90.*SIGN(1,.AIMAG(XVAL(ISTEP)>)  P1450 

290  IF  (IFLG.EQ.O)  GO  TO  300  P1460 

WRITE  (6.690)  X.B.OBDX.UC.XVAL (ISTEP) » AMP. PHASE  P1470* 

300  XSAVEaY(l)  P1480 

GO  TO  160  P1490 

310  IF  (IFLG.EQ.O)  GO  TO  320  P1500 

WRITE  (6.700)  IWR.lNO  P1510* 

C P1520 

C PERFORM  FOURIER  TRANSFORM  P1530 

C P1540 

320  IGAMaGAMMA.l  P1S50 

INUMa2**IGAM  P1560 

N1*N« 1 P1570 

N2*N*2  P1580 

DO  360  IaN2,INUM  P1S90 

Jal-INUM-)  P1600 

XaFLOAT(J)*OE'  X P1610 

OUMa ( 0 . . 1 . ) *AO  »T ( 1 ) *X  P1620 

IF  (CABS(OUM) .5T.30.)  GO  TO  330  P1630 

XVAL (I)aXVAL(l) *CExP (OUM)  P1640 

GO  TO  340  P1650 

330  XVAL(I)a(0.«0.)  P1660 

340  IF  (NORO.EO.O)  GO  TO  360  **1670 

DUMaCSORT (M20-A0AT ( 1 ) *AQAT ( 1 ) ) P1680 

IF  (AIMAG(OUM) .GT.O.)  GO  TO  350  P1690 

OUMa.QUM  P1700 

350  OUMaOUMaaNORO  P1710 

XVAL ( I ) aXVAL ( I ) /OUM  P1720 

360  CONTINUE  P1730 

CALL  FFT  (IGAM.INUM.XVAL.W)  P1740S 

00  370  I-l.INUM  P1750 

370  XVAL(I)aXVAL(I)aOELX/2./PI  P1760 
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delw*c.*pi/delx/inum 

IF  (IFLG.EO.O)  GO  TO  380 
WRITE  (6,710) 

CALCULATION  OF  8(K) 

380  00  440  1*1*1 NUM 

IF  (I.GE.N)  GO  TO  390 
KK* I *N1 

W (KK) *DELW* ( I-N) 

GO  TO  400 
390  KK«I-N*1 

W(KK)*OELW*(I-N> 

400  BN(KK)-XVALIKK) 

AMP* CABS ( BN (KK ) ) 

IF  <ABS(AIMAG(BN(KK) ) ) .LT.l.E-20)  GO  TO  410 
IF  (ABS(REAL(BN(KK, ) ) .LT.l.E-20)  GO  TO  420 
PHASE*ATAN2(AIMAG(BN(KK) ) ,REAL<BN(KK) ) )*FCT 
GO  TO  430 
410  PHASE-0, 

GO  TO  430 

420  PHASE-90. *SIGN(1,,AIMAG(BN(KK) ) ) 

430  WAVEN*REAL(W(KK)) 

IF  (IFLG.EO.O)  GO  TO  440 
WRITE  (6.720)  WAVEN.BN(KK) , AMP, PHASE 
440  CONTINUE 

INP1-INUM.1 

XVAL(INPl)*XVAL(l) 

W ( INP1 ) *W ( 1 ) 

BN ( INP1 ) *BN ( 1 ) 

CALCULATION  OF  FAR  FIELD  DIRECTIVITY  PATTERN 

IF  (IFLG.EO.O)  GO  TO  450 
WRITE  (6,730) 

450  DO  550  M-l.NANG 
ANGLE«TM(M)/FCT 
COST*COS ( ANGLE ) 

WAVEN*OMEGA«VJAO*COST 
IF  ( WAVEN.LT. 0 • ) GO  TO  460 
IVAL«!FIX(WAVEN/DEl«-.001)*1 
IF  (IVAL.LT. 3)  I VA(_*3 
IF  (IVAL.GT. (N-l) ) IVAL*N-1 
GO  TO  470 

460  IVAL»IFIX(WAVEN/DElW-.001) »INP1 
IF  (IVAL.LT. (N2.2) ) IVAl*N2*2 
IF  (IVAL.GT, (INP1-2) ) IVAL-INP1-2 
470  IM2*I VAL-2 
IP2«IVAL*2 
CWAVE* ( 0 , • 0 . ) 

00  490  J-IM2.IP2 
CONT* ( 1 • ,0. ) 

DO  480  KJ-IM2.IP2 

IF  (J.EQ.KJ)  GO  TO  480 

CONT*CONT* ( WAVEN-W (K J) )/(W(J)»W(KJ) ) 

480  CONTINUE 

490  CWA VE*CWA VE.BN ( J) *CONT 
IF  (NORD.EO.O)  GO  TO  520 
IF  (ABS(ANGLE) .LT.l.E-20)  GO  TO  500 


uuu 


VAL"(3wRT(M20-WAVEN*WAVEN) )**NORD  P2360 

60  TO  510  P2370 

500  VAL-0,  P23B0 

510  CWAVE»CWAVE«VAL  ' P2390 

520  PTHETA(M)»2.*REAL(CWAVE*C0NJG(CWAvE))  P2400 

ANGLE-ANGLE*FCT  P2410 

IF  (PTHETA (M) ,LT, 1 .E-20)  GO  TO  530  P2420 

PDB(M)»10.«*LOG10(PTHETA(M) ) P2430 

GO  TO  540  P2440 

530  POB ( H ) ■ 0 • P2450 

540  IP  (IFLG.EQ.0)  GO  TO  550  P2460 

WRITE  (6,740)  ANGLE»PTHETA(M) ,PDB(M)  P 2470* 

550  CONTINUE  P2480 

IP  (INP.EO.O)  GO  To  670  P2490 

P2500 

calculation  op  near  pielo  sound  pressure  level  contours  P25io 

P2520 

IP  (NORO.EO.O)  GO  TO  500  P2530 

00  570  I" 1 » INUM  P2540 

0UM»CSQRT(M20-W(I)«W(I) ) P2550 

IP  (ABS(AIMAGlOUH) , .LT.l.E-10)  GO  to  500  P2560 

IF  (AIMAG(OUM) .GT.o.)  GO  TO  570  P2570 

OUM—OUM  P25B0 

GO  TO  570  P2590 

560  IP  (REAL (DUM) .LT.O.)  OUM—DUM  P2600 

570  BN ( I ) «BN ( I ) *DUM**NoRD  P2610 

500  00  650  1*1 » INP  P2620 

RAD»RSTART«FLOAT(I)*RADNP  P2630 

00  610  J«1,INUM  P2640 

OUM«CSORT (M20-W ( J) *W ( J) ) P2650 

IP  (A0S(AIMAG(DUM) ) .LT.l.E-10)  GO  TO  590  P2660 

IP  (AIMAG(DUM) .GT.O.)  GO  TO  600  P2670 

OUM--DUM  P2680 

GO  TO  600  P2690 

590  IP  (REAL  (OUM)  .LT.O.)  DUM—DUM  P2700 

600  OUMaOUH«RAO  P2710 

CALL  NCBRTS  (OUM,H01 .H02.NORO, 1 ) P2720* 

610  XVAUJ)»BN(J)*H01  P2730 

DO  620  J-l.INUM  ' P2740 

620  XVAL(J)"XVAL(J)*SORT(RAO)  P2750 

CALL  PPT  (IGAM,INUM,XVAl,W1)  P2760S 

00  630  J»1,INUM  P2770 

630  XVAL(J)»XVAL(J)*DElW  P2780 

DO  640  J»2»N  P 2790 

K>J»N  P2800 

640  NFDB ( J , I ) ■ 1 0 . «ALOG l 0 ( 0 , 5*RE AL ( X VAL ( K ) *C0n JG ( X VAL ( K ) ) ) /R*0 ) P28 1 0 

650  NFOB ( 1 , I ) » 1 0 .*ALOGl 0 ( 0 . 5*RE AL ( XVAL ( 1 ) «CON JG ( XVAL ( 1 ) ) ) /«*D)  P2820 

WRITE  (6,750)  RADNr  P2830* 

DO  660  J-1,N  P2840 

K«N» J»2  P26S0 

IP  (J.EQ.l)  K«1  P2860 

X»DELX*PLOAT(J-l)  P2870 

IP  (X.GT.XLAST)  GO  TO  660  P2880 

WRITE  (6,760)  X, (NPDB(K,I) ,I»1,INP)  P2890* 

660  CONTINUE  P2900 

670  RETURN  P2910 

C P2920 

600  FORMAT  (1H1,28X, "VARIATION  OP  FOURIER  TRANSFORM  INTEGRANO"/29X,40H  P2930 
1 •****•*•*••*•*••*•*•*** •••••••••••••••••/28X ,"MODE  NUMBER  »,Il/2  P2940 


28X,"MACH  NUMBER  • ".F10.4/23X, "TEMPERATURE  RATIO  ■ "«F10.4/32X,"EP 
3SIL0N  ■ «,F10.4/34X»"GAMMA  ", I 2///4X, "AXIAL "»3X, "THICKNESS", 

44X,«0BDX»,3X,"CENTERLlNE",2X. "FOURIER  TRANSFORM", 7X,"AH^iTUOE"#2X 
S."PHASE»/3X,"DI STANCE", 22X. "VELOCITY", 2X,"INTEGRAN0,  6<S»"//) 

690  FORMAT  ( I X.4FI 0.4 ,2E12.4,2X,2F1 0,4) 

TOO  FORMAT  <//lX,"IWR  ■ "tIl,2X,"IND  • ",I5//) 

710  FORMAT  (1H1.25X, "WAVENUMBER  SPECTRUM,  B ( K ) "/26X , 

!••••••••••//! X, "WAVENUMBER", 4X, "WAVENUMBER  SPECTRUM", 6X, "AMPLITUDE 

2"»2X,"PHASE"/2lX,"B(K) "//) 

720  FORMAT  < 1 X.F 1 0.4 .2X.2E 12,4, 2X,2F1 0.4) 

730  FORMAT  < 1H1 ,20X,»FaR-EIELO  0IRECTIVITY"/2lX,21H***«*"*»**w*««*«" 
1 ••//9X, " ANGLE", 1 OX, "PTHETA",11X,»P  OB"//) 

740  FORMAT  <6X,F10.4,5X.E12.5,5X,F10.4) 

750  FORMAT  (1H1,20X,"NEAR  FIELD  SOUNO  PRESSURE  LEVEL  C0NTOU«S"/21X,40H 

"RADIAL  SPACING  ■ ", 

2F5.2,"  RADII"//) 

760  FORMAT  < 1 X,F 1 0 .4 ,5x. 1 3FB.2) 

END 
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92990 
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•OECK  RUNREL 

SUBROUTINE  RUNREL  (M, H , y ,DY , P, QiERRES.ADAT , NTT .OB ) 0 10 

COMPLEX  Y(M) ,DY(M) ,P(M) ,0(M) ,RR<4)  0 20 

COMPLEX  AOAT(l)  Q 30 

10  00  20  1*1, M 0 40 

20  0(I)*(0.«0,)  Q 50 

OY(n*(i.,o.)  o 60 

00  30  I*2,M  o 70 

30  DY(I)*<0.,0.)  0 80 

CALL  OERY1  {M,Y,0y,A0AT,NT7»DB)  0 90S 

00  AO  1*1, M Q 100 

P ( I ) »H*0Y  ( I ) * ,5  0 HO 

RB (I)*(P(I)-Q(I)*Y(I) ) -Y ( I ) 0 120 

Y ( I ) * Y ( I ) »RR ( I ) 0 130 

40  0( I ) * (3,*0( I) ) -P< I) ♦ (3,*PR( I ) ) Q 140 

CALL  OERYJ  (M,Y,DY,A0AT,NTT,D8)  0 ISOS 

00  50  1*1, M 0 160 

P ( 1 ) *H*0 Y ( I ) 0 170 

RR(i)«(<P(n-Q<in*.s»Y(in-Y<i)  o iso 

Y ( I ) *Y ( I ) *RR ( I ) 0 190  i 

50  0<I)*(3.*P<I) ) - ( 2 • *Q ( I) ) - 1 6, *RR 1 1 ) ) Q 200 

CALL  DERY1  (M.Y.OY, AOAT,NTT,OB)  0 210S 

ERRES*0,  Q 220 

00  70  I * 1 * M 0 230 

IF  (CABS(P(I)-O(I)).LT,l.E-20)  GO  TO  60  0 240 

E*CABS ( ( tM«DY ( I ) ) -P ( I ) I / (P ( I ) -0 ( I ) ) ) Q 250 

IF  (E.GT.ERRES)'  ERRES*E  0 260 

60  P(I)*H*0Y(I)-.5*P(I)  Q 270 

RR(I)*(P(I>*Y(I) )-Y(I)  0 200 

Y ( I ) *Y ( I ) ♦RR  < I ) Q 290 

70  0(I)«0(I)*6.*(P(I)-RR(I))  0 300 

CALL  0ERY1  <M,Y,OY,AOAT,NTTtOB)  Q 310S 

DO  80  1*1 |M  0 320 

P < I > * (“4,*P ( I ) *H»Oy ( I ) *0 1 1 ) ) /6»  0 330 

RR(I>*(P<I)*Y<I))-v(I>  0340 

Y 1 1 » »Y 1 1 » *RR ( I » 0 350 

80  0(1) *RR ( I ) -P ( I ) 0 360 

RETURN  Q 370 

END  0 380- 
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•DECK  DERY1 

SUBROUTINE  0ERV1  (M.Y.Dy.aDaT.NTT.OB)  R 10 

COMPLEX  Y<M) ,DY<M) .ADATINTT) .AVAL  R 20 

complex  alpha (OKOB  R 30 

COMPLEX  YPEAK, APEAK, X0  R 40 

REAL  KAPPA. KAPB.MaCH2.VJA0  R SO 

COMMON/DATA/KAPPA, EPSI.POTB.IFLAG  R 60 

COMMON/ INFO/ ALPHA, OMEG A, MACH2 « TJTO.NORD.GM1 . DKDB.IFLG.VJA0  R 70 

COMMON/OECAY/  ID. SO  R 60 

R 90 

calculation  or  obdx  ano  ducox  r 100 

« no 

B»REAL(Y(2n  R 120 

ir  (B.LT.POTB)  GO  TO  AO  R 130 

IF  (IFLAG.E0.2)  GO  TO  10  R 140 

KAPPAbPOTB* ( 1 ,-KAPPA«2,0* (EPSI-l ,/REAL  <7  < 1 ) ) ) /0.04)  R ISO 

IFLAG-2  R 160 

10  AA«0.2*MACH2  R 170 

ABb(I.-TJTO-AA)  R 160 

UCbREAL  < Y (3) ) R 190 

KAPBb0,04*(1.0-KAPPA/B>  R 200 

ir  (AA.LT. l.E-10)  GO  TO  20  R 210 

AK>S0RT(AB«AB«4.*AA)  R 220 

RH08>1 ./ ( 1 . -0.5*uC* ( AB*0.5*UC*AA) ) R 230 

DBDXb,693147*KAPB*uC**3*RH0B/<UC/AA-<  <A8.AA*UC) *ALOG<AB$< (AA*UC«AB  R 240 

1>*UC-1.) )-<AB*AB*2.*AA*AA*AB*UC)*ALOG(ABS<  <2.*AA*uC*AB-Ak)*(A8*AK)  R 2S0 

2/<2.*AA*UC*AB*AK)/<AB-AK)))/AK)/2./AA/AA)/2,  R 260 

DUCDXbI, 38629* <AA*uC*UC»AB*UC-l,)*0BDX/UC/B**3/TjT0  R 270 

GO  TO  SO  R 260 

20  ir  (AB.LT. l.E-10)  GO  TO  30  R 290 

RHOB*l./(l.-UC*AB)  R 300 

0B0X«,693147*KAPB*uC**3*RH0B*AB/ (UC*UC/2, »UC*  < 1 ,-UC) /AB*  < 1 ,-UC*AB)  R 310 

l*ALOG(ABS(l.-AB*UC) )/AB/AB)/2.  R 320 

OUCOX—1. 38629*11. -AB*UC)*DBOX/B**3/UC/TJTO  R 330 

GO  TO  SO  R 340 

30  D80X*2.07944*KAPB/B  R 350 

DUCOX*-UC*OBOX/B  R 360 

GO  TO  50  R 370 

40  OBOXbEPSI  R 360 

OUCOX*0.  R 390 

R 400 

CALCULATION  OF  AX]Al  DERIVATIVES  R 410 

R 420 

50  OY(2)*CMPLX(DBDX.O.)  R 430 

DY(3)*CMPLX(DUCDX.o.)  R 440 

IF  (B.GT.SO)  GO  TO  70  R 450 

IF  (B.GT. (NTT*DB) ) GO  TO  60  R 460 

CALL  COEFF  (ADAT.NtT.B.AVAL.08)  R 470S 

DY<4)»(0«tl,)*AVAL*Y(4)  R 460 

RETURN  R 490 

60  DY (4) ■ <0,. 1. )*Y( 4) *CHPLX( OMEGA/REAL (Y (3) ) »AIMAG< AOAT (NTT) )*NTT*08/  R 500 

IB)  R 510 

RETURN  R 520 

70  IF  (ID.GT.l)  GO  TO  60  R 530 

YPEAK»Y (4)  R 540 

CALL  COEFF  (ADAT.NTT.B, APEAK. OB)  R 550S 

X0*Y  < 1 ) R 560 

SIGMAbAL0G(CA8S(YPEAK) ) /REAL (X0*X0)  R 570 

APRbREAL (APEAK)  R 560 

10*2  R 590 

60  DY(4)»Y(4)*< -2. 0* SIGN A* (Y(1)-XO)*(0..’.)*APEAK*(2.0*Y(1)/XO-1.0))  R 600 

RETURN  R 610 

END  R 620- 
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SUBROUTINE  COEFF  ( A . NG, Si  AVAL .00) 

S 

10 

COMPLEX  A ( 1 > .AV*L,AltA2,A3 

s 

20 

I » IF  I X ( (S-0.05)/DB) 

s 

30 

IF  (I.EO.l)  1*2 

s 

40 

IF  (I.EO.NG)  I«NG-1 

s 

50 

IF  (I.GT.NG)  GO  TO  10 

s 

60 

DS«S-0.05-(I-1)*OB 

s 

70 

AI»(*tI-l>-2.«A(I)*A(Ul))/2./DB/0B 

s 

80 

A2«(4,*A(I)-3.*A(I_n-A(I*l>  I/2./0B 

s 

90 

A3-A ( 1-1 ) 

s 

100 

AVAL"0S*(A1*DS»A2)*A3 

s 

no 

RETURN 

s 

120 

END 

s 

130 
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•deck  fft 

SUBROUTINE  EFT  (IGam, INUM. XVAL. W)  T 10 

TO  COMPUTE  THE  FOURIER  EXPONENTIAL  TRANSFORM  OF  X(T)  T 20 

USING  THE  FFT  BY  BRIGHAM  AND  MORROW  T 30 

T AO 

IGAm  - POWER  OF  TWO  NUMBER  OF  POINTS  T SO 

INUM  > NUMBER  OF  POINTS  T 60 

w - working  array  of  dimension  inum  dimensioned  t 70 

IN  calling  routine  t 80 

XVAL  - DATA  POINT  ARRAY  OF  DIMENSION  INUM  DIMENSIONED  T 90 

IN  CALLING  ROUTINE.  XVAL  IS  oefineo  SUCH  that  t ioo 

XVAL(I)»  value  at  t-o  t no 

XVAL(INUM/2»H"  VALUE  at  T-PERIOD/2  T 120 

XVAL ( lNUM/2.2 ) ■ VALUE  AT  T*-PERIOO/2  T 130 

XVAL(InUM)*  VALUE  at  T»-DELT  T 140 

XVAL  IS  RETURNED  AS  THE  FOURIER  TRANSFORM  S(F!  T ISO 

IN  STEPS  OF  DELF-l/PERIOD.  5(F)  IS  FOLDED  *B0UT  T 160 

F»INUM/2«PERI00  T 170 

FOR  A WAVENUMBER  TRANSFORM  ThE  CALLING  PROGRAM  T 160 

must  subsequently  divioe  bt  2«pi  and  multiply  t i»o 

BY  DELX  FOR  A CONSISTENT  TRANSFORM,  FOR  A fREOUENCY  T 200 

TRANSFORM  The  CALLING  ROUTINE  MUST  MULTIPLE  BY  DELT  T 210 

TO  OBTAIN  TRANSFORM  AS  DEFINED  BY  BRIGHAM  AND  MORROW.  T 220 

T 230 
T 240 

COMPlFX  XVAL(INUM) .W(INUM) .VAL.XDUM  T 250 

COMPLEX  CEXP  T 260 

PI»3. 14159265359  T 270 

NUM«2»* ( I 6AM. 1 ) T 280 

DO  10  I-l.NUM  T 290 

AI-I-1  T 300 

ANUMaNUM  T 310 

10  W(I)bCExP(-(0..1.)«PI*AI/ANUM)  T 320 

00  20  IOUT»l.IGAM  T 330 

N2«2«*UOUT-l>  T 340 

IGMalGAM-IOUT  T 350 

IGM2»2#*IGM  T 360 

DO  20  KKK-1.N2  T 370 

DO  20  KK»1 • IGM2  T 380 

1 VAL«KK-1 * (KKK-1 ) »2»IGM2  T 390 

IF  (IVAL.EQ.O)  IVAL-0  T 400 

ISOLl«ISOL<IOUT,IGAM,IVAL)*l  T 410 

IDASH1«IDASH(I0UT,IGAM,IVAL)*1  T 420 

K1»IM0VE(I0UT,IGAM,IVAL)*1  T 430 

IVAL«IVAL*1  T 44) 

KVAL>IVAL«IGM2  T 450 

XDUM«XVAHI0ASH1)  T 440 

VAL"W (K1 ) *X VAL ( I SOL  1 ) T 470 

XV*L ( I VAL) “XDUM. VAl  T 480 

20  XVAL (KVAL) ■XDUM. VAl  T 490 

NUMlaINUM-1  T 500 

DO  30  I«1.NUM1  T 510 

U«IREV(IGAM,I).l  T 520 

IVAL«I*1  T 530 

IF  (IVAL.GT.il)  GO  TO  30  T 540 

XDUM-XVAL(IVAL)  T 550 

XVAL(IVAL)»XVAL(I1)  T 560 

XVAL  (ID  "XDUM  T 570 

30  CONTINUE  T 580 

RETURN  T 590 

END  T 600* 


- -Jte: 


•DECK  I SOL 

f UNCTION  ISOL(IOUT,IOAM,K> 
IB«2»»(I0AM-I0UT) 
IW«IB.*ND.K 
IF  (1W'EQ,0)  60  TO  10 
ISOL-K 
RETURN 
10  ISOL>K»IB 
RETURN 
ENO 


U 

U 

U 

U 

U 

U 

U 

U 

U 


10 

20 

30 

40 

SO 

60 

70 

SO 
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•DECK  I MOVE 

FUNCTION  I MOVE (IOUT»!OAh«K)  v 10 

IE-1  V 20 

IG-IGAM-1  y 30 

DO  10  I-l.IG  y 40 

10  I2»I2*2**I  V SO 

I1-K.AND.I2  V 00 

I3«1GAM-I0UT  V 70 

I4-SHIFT(I1,-I3)  V SO 

I1>C0HPL(I2)  V 90 

I3»I1.AND.K  V 100 

I1»I3«0R» 14  V HO 

I MOVE* I RE V ( I GAM  til)  V 130 

RETURN  V 130 

V 140- 
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w 

w 

w 

M 

W 

w 


10 

20 

30 

*0 

50 

60- 


•DECK  I REV 

FUNCTION  IREV(M,IIj 

12-1 
NG-M-1 

DO  10  I-l.NG 
10  12-12*2**1 
I1-II.AND.I2 

13- 11, AN0.152525B 

14- SHIFT<I3* l) 

13- 11- AND. 1252528 
I5«SHIFT(I3,-1) 

1 3" 14, OR, 15 

14- 13. AND. 314638 

15- SHIFT ( 14,2) 

1 6* 1 3. AND, 146314B 

13- SHIFT(I6,-2) 

14- 13. OR. 15 

13- 14. AN0.7417B 

15- SHIFTU3.4) 

1 3“ 1 4, AND, 170 3606 

16- SHIFT  < 13,-4) 

14- 15, OR. 16 
13-14, AND, 377B 

15- SHIFT ( 13,8) 

13- 14, ANO, 1774008 

16- SHIFT ( 13, «8) 

14- 15, OR. 16 
IM-16.M 

IF  < IM.EQ.O)  GO  TO  20 

15- SHIFT(I4,-IH) 

GO  TO  30 

20  15-14 
30  I3-COHPL(I2) 

14-13. AND. II 

IREV-I5.0R.I4 

RETURN 

ENO 


X 10 
X 20 
X 30 
X 40 
X 50 
X 60 
X 70 
X 80 
X 90 
X 100 
X 110 
X 120 
X 130 
X 140 
X 150 
X 160 
X 170 
X 160 
X 190 
X 200 
X 210 
X 220 
X 230 
X 240 
X 250 
X 260 
X 270 
X 280 
X 290 
X 300 
X 310 
X 320 
X 330 
X 340 
X 350 
X 360- 
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•DECK  ASTAP* 

SUBROUTINE  ASTART  ( VJAO.STRNO.TJTO. ALPHA, NORO.IEROR)  V 10 

COMPLEX  ALPHA,ASTaR0<4,3,8) .ASTARl (4,3*8> ,A(7.7).B<7)  V 20 

COMPLEX  ALSTAR(4,3,B)  V 30 

COMMON/ADATA/ASTArOiASTARI  Y 40 

Y 50 

LOCATE  CLOSEST  VALUE  IN  STARTING  VALUE  MATRIX  Y 60 

Y TO 

IF  (STRNO.LE. 0.065)  I«1  Y 80 

I F (STRNO. LE. 0.2. and. STRNO.GT. 0.065)  !>2  Y 90 

IF  ( STRNO, LE .0. 4. A^O. STRNO.GT. 0.2)  I»3  Y 100 

IF  (STRNO.GT. 0.4)  I«4  Y 110 

IF  (TJT0.LE. I .63)  J-l  Y 120 

IF  (TJT0.LE.2.56.AND.TJT0.GT.1.63)  J"2  Y 130 

IF  (TJT0.GT .2.56)  J*3  V 140 

KalFIXI  (VJA0«0.S>/0.25)*1  Y 150 

1KEY-I  Y 160 

JKEY-J  Y 170 

IF  (NORO.EO.O)  GO  TO  20  Y 180 

00  10  11*1 *4  Y 190 

00  10  JJ-1,3  Y 200 

DO  10  KK>1,8  Y 210 

10  ALSTARI I I . JJ.KK) aASTARl ( II » JJ.KK)  Y 220 

GO  TO  40  Y 230 

20  00  30  II>lt4  Y 240 

DO  30  JJ»1,3  Y 250 

DO  30  KK>1,8  Y 260 

30  ALSTAR(II .JJ.KK) sASTARO ( 1 1 ,UJ,KK)  Y 270 

Y 280 

CALCULATE  STARTING  VALUE  MATRIX  Y 290 

Y 300 

40  00  90  IFL>1«7  Y 310 

IF  (IFL.E0.1)  GO  TO  80  Y 320 

IF  (IFL.LT.4)  GO  TO  60  Y 330 

IF  (IFL.LT.6)  GO  To  70  Y 340 

IF  UFL.EQ.6)  00  To  50  Y 350 

K>K*2  Y 360 

GO  TO  80  Y 370 

SO  K»K-1  Y 380 

IF  (K.EO.O)  K«2  Y 390 

IF  (K.E0.7)  K«K-1  Y 400 

I«IKEY  Y 410 

00  TO  80  Y 420 

60  J«J*1  Y 430 

IF  (J.E0.4)  J*1  Y 440 

GO  TO  80  V 450 

70  JbJKEY  V 460 

I«I*1  Y 470 

IF  (I.E0.5)  I»2  Y 480 

80  IF  (I.EQ.l)  Sl-0,03  Y 490 

IF  (I.E0.2)  Sl-0.1  Y 500 

IF  (I.E0.3)  Sl-0.3  Y 510 

IF  (I. EG. 4)  Sl*0.5  Y 520 

IF  (J.EO.l)  Tl*l .0  Y 530 

IF  (J.E0.2)  Tl-2.273  V 540 

IF  (J.E0.3)  Tl-2.857  Y 550 

AM1>0,S*(K-1)*0.25  Y 560 

A(IFl,l)»(l.,0.)  Y 570 

A(IFLf2)>Sl  Y 580 
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A(IFL»3)>S1»S1 
A<IF L.*)»T1 
A<1FC.5)»T1*T1 
A(irt*6)>AMl 
A(IFtfT)*AMl*AMl 
•0  BUFL)»ALSTAR<I,J,K> 


CALL  FOR  SOLUTION  OF  SIMULTANEOUS  EQUATIONS 

CALL  SIMQ  (A.B.TtKs) 

IF  (KS.EO.O)  OO  TO  100 

1ER0R«2 

RETURN 

CALCULATE  STARTING  VALUE 

100  ALPHAaB(l)«B(2)*STRNO*B(3)*STRNO*STRNO*B(4)*TJTO«B(S)*TJTO*TJTO*B( 
16) *VJA0*B (7) *VJA0*V JA0 
RETURN 
ENO 


Y 590 

Y 600 

Y 610 

Y 620 

Y 630 

Y 640 

Y 650 

Y 660 

Y 670 

Y 6S0S 

Y 690 

Y 700 

Y 710 

Y 720 

Y 730 

Y 740 

Y 750 

Y 760 

Y 770 

Y 780- 
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•DECK  SIHO 

SUBROUTINE  SIMQ  (A,B,N,KS)  AA  10 

COMPLEX  A(l) ,8(1) ,BIGA,SAVE  AA  20 

AA  30 

FORWARD  SOLUTION  AA  40 

AA  SO 

TOL-O.O  AA  60 

KS>0  AA  70 

JJa-N  AA  B0 

00  B0  J>I«N  AA  90 

JY" J* 1 AA  100 

JJbJJ»N*1  AA  HO 

BIGA* ( 0. *0. ) AA  120 

ITaJJ.J  AA  130 

DO  20  IaJ,N  AA  140 

AA  ISO 

SEARCH  FOR  MAXIMUM  COEFFICIENT  IN  COLUMN  AA  160 

AA  170 

1 Ja  I T ♦ I AA  ISO 

IF  (CABS(BIGA)-CABS(A(IJn ) 10*20,20  AA  190 

10  BIGA-A(IJ)  AA  200 

I MAX* I AA  210 

20  CONTINUE  AA  220 

AA  230 

TEST  FOR  PIVOT  LESS  THAN  TOLERANCE  (SINGULAR  MATRIX)  AA  240 

AA  250 

IF  (CABS (BIGA) »TOL)  30,30,40  AA  260 

30  KS-1  AA  270 

RETURN  AA  280 

AA  290 

INTERCHANGE  ROWS  IF  NECESSARY  AA  300 

AA  310 

40  Il>J»N*(J-2)  AA  320 

IT-IMAX-J  AA  330 

OO  50  K» J»N  AA  340 

I 1*1 1 *N  AA  350 

I2aIl.IT  AA  360 

SAVE-A(H)  AA  370 

A ( 1 1 ) aA ( 12)  AA  380 

A ( 12) *SAVE  AA  390 

AA  400 

01  VIDE  EQUATION  By  LEADING  COEFFICIENT  AA  410 

AA  420 

50  A(I1)bA(I1) /BIGA  AA  430 

SAVEaB(IMAX)  AA  440 

B(IMAX)aB(J)  AA  450 

B ( J) aSAVE/BIGA  AA  460 

AA  470 

ELIMINATE  NEXT  VARIABLE  AA  480 

AA  490 

IF  (J.N)  60,90,60  AA  500 

60  IOSaNMJ-1)  AA  510 

OO  80  lXaJY,N  AA  520 

IXJalOS.lX  AA  530 

I Taj. IX  AA  540 

OO  70  JXaJY,N  AA  550 

IXJXaN«(JX-l)«lX  AA  560 

JJX>IXJX«IT  AA  570 

70  A ( IXJX) aA ( I XJX) . ( A ( IX J) *A ( JJX) ) AA  580 
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3(IX>aB<lX>-<B(J><»A(IXJ)) 

AA 

AA 

500 

000 

BACK  SOLUTION 

AA 

AA 

610 

620 

NVaN«l 

AA 

630 

ITaN*N 

AA 

660 

DO  100  J«lfNY 

AA 

650 

IAaIT-J 

AA 

660 

IBaN-J 

AA 

670 

ICaN 

AA 

6B0 

00  100  K«1 * J 

AA 

690 

B(IB)aB(IB)»A(lA)*B(IC) 

AA 

700 

XAaJA-N 

AA 

710 

ICalC-l 

AA 

720 

RETURN 

AA 

730 

CNO 

AA 

760 

•DECK  BLKLSN 

BLOCK  DATA  LSN 
COMPLEX  ASTARO 
COMMON  /AOATA/ 
DATA  (((ASTARO 


DATA  (( (ASTARO ( 
(.09622. -.0102) 
(.09638.-. 0156) 
(. 09628, -.01T5) 
(.09656, -.00982 
(.09696, -.0150) 
(.09T00.-.0170) 
(. 09678, -.009*7 
(.09733, -.0145) 
(.09766, -.0165) 
(.09790,-. 00917 
(.09765, -.0141) 
(.09782, -.0160) 


.09358. 

.09268. 

.09227. 

.09370, 

.09282, 

.09258, 

.09432, 

.09385, 

.09340, 

.09584, 

.09555, 

.09528, 


•.00988 

•.0147) 

•.0165) 

-.0104) 

..0155) 

..0173) 

•.0110) 

>.0163) 

•.0183) 

..0109) 

•.0164) 

•.0183) 


4,3,8) , ASTAR1 (4,3,8) 
ASTARO, ASTAR1 
1»J.K> ,1-1,4) ,J>1,3) 
>,(. 3018, -1. 0835), (. 


.2843, 
.2762, 
,.3045, 
.2885, 
.2806, 
.3118, 
.2965, 
.289S, 
,3230, 
.3085, 
.3018, 
J»K) , I 
.3345, 
.3225, 
.3162, 
(.3425 
.3355, 
.3300, 
(.3688 
.3472, 
.3432, 
(.3540 
.3578, 
.3568, 


-.1235) , < 
-.1375), ( 
-.0895) , ( 
-.1312),  ( 
-.1450) , ( 
-.0943) , ( 
-.1402) , ( 
-,1538) , ( 
-.0957) •( 
-.1443) ,( 
-.1593) , ( 
•1,4) ,J"1 
-.0945) •( 
-.1450) , ( 
-.1618) • ( 
,-1,0907) 
-, 1430) , ( 
-.1610),! 
,-.0855) , 
-, 1371 ) , ( 
-.1585), ( 
,-.0790), 
-.1318) , ( 
-.1525) • ( 


3) ,K*1 ,4)  / 
(.8303, -.5622) 
S727t-. 83452) • 
4225,-. 8857), ( 
8813,-. 6U1), ( 
6531,-. 9349), ( 
4920*-! .0286) • 
9654, -.6463) , ( 
7901,-1.0089), 
6586,-1.1550), 
.0682, -.6527) , 
9465t-l .0326) , 
8603,-1.1941), 
3>,K«5,e>  / 
.1765, -.6259) , 
.0996,-1.0170) 
.0434,-1.1779) 

(1.2??1,..5613 
.2445, -, 9702) , 
.2092,-1.1304) 
1.3532, -.4552) 
.3808, -.8920) , 
.3623,. 1,0552) 
1.3646, -.3370) 
,4992«>.7761), 


DATA  ( ( ( ASTAR1 

(I 

»J»K) , 1*1,4) , J-l ,3) , 

K*1 ,4)  / 

1 

(.1013, 

.0930) 

.353, 

.291) 

.(1.0606, 

-.7623) , 

2 

(.1071, 

.1403) 

.388, 

.427) 

,(1.0934, 

-1.1439) 

3 

(.1095, 

.1573) 

.402, 

.475) 

,(1,0913, 

-1*2721) 

4 

(.1015, 

.0930) 

.357, 

.293) 

, (1.0949, 

-.7973), 

5 

(.1074, 

.1405) 

.393, 

.431) 

,(1.1354, 

•1.1581) 

6 

(.1096, 

.1576) 

.407, 

.477) 

,(1.1359, 

•l .2671 ) 

7 

(.1018, 

.0933) 

.363, 

.297) 

,(1.1461, 

-,8l00)  , 

8 

(.1078, 

.1408) 

,401, 

.435) 

,(1.1952, 

•1,1708) 

9 

(.1103, 

.1581) 

.414, 

.479) 

,(1.1990. 

•1.3006) 

S 

(.1022, 

.0936) 

.372, 

.301) 

,(1.2134, 

-.BIS!) , 

S 

(.1083, 

.1414) 

.410, 

.437) 

,(1.2715, 

-1.1754) 

s 

(.1110, 

.1565) 

.424, 

.462) 

•(1.2790, 

•1.3067) 

DATA  (( 

ASTAR1 

(1 

» J,K) 

, 1*1 ,4) « J»l»3) , 

K"5,8)  / 

1 

(.1027, 

.0943) 

.361, 

.304) 

,(1.2926, 

-.7999), 

2 

(.1090, 

.1420) 

.421  * 

.439) 

,(1.3611, 

•1.1669) 

3 

(.1117, 

.1590) 

•436, 

.464) 

,(1.3730, 

-1,3005) 

4 

(.1032, 

.0948) 

.393, 

.307) 

,(1.3790, 

-.7646), 

5 

(.1099, 

.1426) 

.434, 

.441) 

,(1.4604, 

-1.1414) 

6 

(.1126, 

.1596) 

.451, 

.466) 

,(1.4774, 

•1.2776) 

7 

(.1040, 

.0953) 

.407, 

.306) 

,(1.4639, 

-.7010), 

8 

(.1109, 

.1431) 

.450, 

.441) 

,(1.5657, 

-1.0942) 

9 

(.1138, 

.1603) 

,467  , 

.485) 

,(1.5886, 

-1.2345) 

5 

(.1049, 

.0956) 

.422, 

.303) 

,(1.5320, 

-,8039) , 

9 

(.1122, 

.1438) 

.466, 

.437) 

,(1.6713, 

•1.0205) 

5 

(.1151, 

.1611) 

.484, 

.462) 

,(1.7025, 

•1,1668) 

(1.4941,. 1.3801), 
1.5899,-2.4995), 
.6951,-2.8943), 
.6631,-1.3868), 
.7oOl.-2.3972), 
1.7864,-2.8183) , 
.8513.-1.3641), 
1.8762.-2.2768), 
1.930*. -2. 7002), 
2.0507,-1.3039) , 
2.0944,-2,1508), 
2.1292,-2.5534)  / 

2. 2S61. -1,1935), 
<2, 3324, .2, 0077) , 
(2. 3664, .2, 3866) , 
, (2. 4SS,. 1.0065), 
2. 5775, -1.8286) , 
(2,6217,-2.1918), 
(2.5695,-0.6875), 
2, 8178, -1,5880) , 
(2. 8803, -1.9492), 
(2.7506,0.0000), 
3.0192,-1.2388) • 
3. 122?. -1.6252)  / 


1,7405.-1,3550) . 
(1.6609,-2.1340), 
(1,5279,-2.5331), 
1.8407, -1,3815) , 
(1.8220,-2.1505), 
(1.7537,-2.5379  ), 
1.9793,-1.3880) , 
(2.0182,-2,1410), 
(1.9946,-2.5056) , 
2.1455,-1,3590) , 
(2.2342,-2,0963) , 
(2. 2422, >2,44 16)  / 

2.3276,-1.2818) , 
(2,4613,-2.0123) , 
(2,4945,-2.3437), 
2.5121.-1,1393), 
(2.6935,-1.8810) , 
(2.7490,-2,2042), 
2.6612,-0,8973), 
(2,9229,-1,6878) • 
(3.0011,-2.0110), 
2.6335,-0,5950) , 
(3.1281,-1.4037), 
(3,2391,-1.7421)  / 


AB  100 
48  HO 
AB  120 
AB  130 
AB  140 
AB  150 
AB  160 
AB  170 
AB  180 
AB  190 
AB  200 
AB  210 
AB  220 
AB  230 
AB  240 
AB  250 
AB  260 
AB  270 
AB  280 
AB  290 
AB  300 
AB  310 
AB  320 
AB  330 
AB  340 
AB  350 
AB  360 
AB  370 
AB  380 
AB  390 
AB  400 
AB  410 
AB  420 
AB  430 
AB  440 
AB  450 
AB  460 
AB  470 
AB  480 
AB  490 
AB  500 
AB  510 
AB  520 
AB  530 
AB  540 
AB  550 
AB  560- 
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•DECK  MXNOZSE 

SUBROUTINE  MXNOISE  (NO,  ILWR.OPNO»BOPNO«  lOPT.ROO.DFT.TOF .AO.VJ.VJAO  AC  10 

1 .TJTO. I »FREQ»S»ZM»SM.RSV.ALTB,BLTB.SPL8tSPLP0»SPLP0.lN6)  AC  20 

DIMENSION  SPLB(l) »FREQ(1) .SMO (26)  AC  30 

DIMENSION  Tl(6>  AC  40 

REAL  KS.KZRZ.LH.LmM  AC  SO 

INTEGER  OC.BOPNO.OPNO  AC  AO 

C AC  TO 

COMMON/ONE/  SPLNO(28>.CQ(2B).SPLNO(2B»»CD(2S).UCLUJ(2G),SO(28.6)  AC  80 

COMMON/ELC VEN/X ( 7 ) AC  90 

COMMON/TWELVC/DEC (7)  AC  100 

AC  110 
AC  120 

DATA  IC.0C.IT/2HIC.2M  .2MIT/  AC  130 

DATA  Tl/0.98.1, 77.2. 209*3.330*0. 0.0.0/  AC  140 

AC  ISO 

1ND>0C  AC  160 

TM>ZM*57. 2957795  AC  170 

IF  (0PN0.EQ.2.0R.0PN0.E0.5)  60  TO  10  AC  180 

SaFREQ(I)»DFT/VJ  AC  190 

SMaO.O  AC  200 

IF  ((TM.LE.4S.O.ANO.VJAO.GE.1.15>.ANO.(S,GE.0.1.ANO,S,IE,O.S)>  GO  AC  210 

1TO  410  AC  220 

AC  230 

THIS  LOOP  CALCULATES  SMO  FOR  A GIVEN  TUTO  AC  240 

FOR  ALL  16  VALUES  OF  SM  (PACKAGE  8)  AC  250 

AC  260 

10  DO  60  Naif 28  AC  270 

IF  (TJT0.GE.0.9B.ANO.TJT0.LE.3.33)  GO  TO  20  AC  280 

IF  (TJT0.LT.T1U))  SMD(N)aSO(Nt 1) • (T1 ( 1> -TJTO) • (SO (N«2> -SO (N. 1 ) ) /(  AC  290 

1T1(2)-T1(1)>  AC  300 

IF  (TJT0.GT.TK4))  SMD  ( N)  aSD  (N.4)  AC  310 

IF  (SMO(N).LT.O.O)  SMO (N) aO.O  AC  330 

GO  TO  60  AC  340 

20  J*2  AC  350 

30  IF  (TJTO-Tl(J))  50,50.40  AC  360 

40  Jaj«l  AC  370 

GO  TO  30  AC  380 

50  SMO|N)aSD(N,J)*(Tl{J)-TJTO)a(SD(NfJ-l)aSD(NfJ))/(Tl(J)-!l(J-l>)  AC  390 

60  CONTINUE  AC  400 

AC  410 

THIS  SECTION  ITERATES  TO  FIND  SM  ASSOCIATED  WITH  THE  REOUIREO  S AC  420 

AC  430 

ICOUNTaO  AC  440 

SOaFREO(I)*DFT/VJ  AC  450 

SMlaO.Ol  AC  460 

SMaSMl  AC  470 

CALL  DOPPLE  (NU.SM.Zf TS.GS.DS.DMf SfTZ.El.ETAI fROOA. ROO. ZM. TOF tVJAO  AC  480S 

1 1 TJTO.OAMA)  AC  490 

Sla$  AC  500 

SM2aO,63  AC  510 

SMaSM2  AC  520 

CALL  OOPPLE  (NU.SM.Z.TS.GS.DS.DM. S.TZ.EI .ETAI.RODA.ROO.ZM.TOF. VJAO  AC  530S 

1. TJTO.OAMA)  AC  540 

S2aS  AC  550 

SMEaSMl*(SO«Sl)a(SM2-3Mn/(S2-Sl)  AC  560 

SMaSME  AC  S70 

IF  (SM.LT, 0.0)  GO  TO  380  AC  S80 
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CALL  COUPLE  <NU,SM,Z,TS,GS.DS,DM,S.TZ,EI,ETAI,RODA,ROD.Zm.TOF,VJAO  AC  590$ 

l.TJTO.GAMA)  AC  600 

SOE*S  AC  610 

IE  (ABS(SOE-SO) .LE.0.001)  GO  TO  80  AC  620 

70  SM1-SH2  AC  630 

SM2«SME  AC  660 

S1*S2  AC  650 

S2*SOE  AC  660 

SHE* SMI* ( SO-S1 ) • (SM2-SM1 ) / (S2-S1 ) AC  670 

SM>SME  AC  680 

IF  (SM.LT.0.0)  GO  TO  380  AC  690 

CALL  DOPPLE  (NU.SM.Z.TS.GS.DS.DM.S.TZ.EI.ETAI . RODA .ROO.ZM, TOF • VJAO  AC  700$ 

l.TJTO.GAHA)  AC  710 

50E*S  AC  720 

I COUNT* I COUNT* 1 AC  730 

IF  (ABS(SOE-SO) .LE.0.001)  GO  TO  80  AC  740 

IF  ( ICOUNT ,£0,50 ) GO  TO  370  AC  750 

GO  TO  70  AC  760 

AC  770 

THIS  SECTION  INTERPOLATES  VALUES  OF  SmO. SPLNQ. SPLND.CO.CD  AC  780 

AC  790 

80  SM*SME  AC  800 

S*SOE  AC  810 

SH1000*SM»1000.0  AC  820 

Y*AL0G1 0 ( SMI 000 ) AC  830 

XX*10«0#Y»14  AC  840 

IF  (XX.GT.28)  GO  To  350  AC  850 

IF  (XX.LT.1.0)  GO  TO  350  AC  860 

JX*XX  AC  870 

J1*JX*1  AC  880 

EX*XX-JX  AC  890 

SMOI*SMO(JX)«EX«(SmO(J1)-SMO{JX))  AC  900 

SPLNQI*SPLN0(JX)*EX«(SPLN0(J1)-SPLNQ<JX) ) AC  910 

SPLNOI*SPLNOI-20.0#ALOG10(RODA/72,0)  AC  920 

SPLNOI*SPLND< JX) *EX*<SPLND(J1)-SPLN0(JX) ) AC  930 

SPLN0I*SPLN0I»20 ,0*ALOG10 l ROD A/72,0)  AC  940 

COI«CO(JX) *EX«(C0(J1)-C0(JX) ) AC  950 

COI*CD(JX)*EX*(CD(jl)-CO(JX))  AC  960 

C AC  970 

IF  (BOPNO.EO.l)  GO  TO  100  AC  980 

IF  (8OPNO.E0.2)  GO  TO  90  AC  990 

C AC1000 


90  PI*3. 141593  AC  1010 

KZRZ«PI«FREO<I)*DFt/AO  AC1020 

OELRAD* (SMOI*VJAO ) / <DM*KZRZ)  AC1030 

UCLUJI*UCLUJ(JX)*Ex*(UClUJ(J1)-UCLUJ(JX) ) AC1040 

UICZ-VJAO  AC1050 

IF  (OELRAD. GT. 1,818535)  UICZ*VJAO*UCLUJI  AC1060 

ETAIN-ETAI  AC1070 

IF  (OELRAO.GT. 1,818535)  ETAIN«ETAI/UCLUJI  AC1080 

GM-IGAMA-l. 01/2.0  AC1090 

TITZ*1.0-GM*UICZ*UICZ« (TS-1.0*GM*ETAIN«ETAIN*UICZ*UICZ)/ETAIN  AC1100 

GO  TO  100  AC1110 

C AC1120 

100  KS*(05*0S)/(TS*GS)-(C0S(Z)*C0S(Z) ) AC1130 

OSP2*OS*OS*0.06*0.06»VJAO»VJAO*COSIZ)»COS(Z)  AC1140 

INO*OC  AC1150 

IF  (KS.LT.0.0)  GO  TO  170  AC1160 

C AC1170 
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••PREDICTION  OUTSIDE  CONE  Or  SILENCE**  ACUSO 

AC1190 

QUAORUPOLE  CONTRIBUTION  AC1200 

ACI210 

LH-80.0* ALOGlO (VJAO)  AC I 220 

CA— 10.0*  (2«NU*3) •ALOGlO  (DM)  AC1230 

IP  (BOPNO.EQ.l)  GO  TO  HO  AC1240 

IP  (B0PN0.E0.2)  GO  TO  120  AC12S0 

110  PP«10.0*ALOG10(OS«*4*DSP2*«(NU-2H-30.0*ALOG10(TS)-20,0*AL0610(GS)  AC1260 
ZZ-i .0* (COI* (TS*TS) • <GS*GS) • ( ( 1 . 0/OS) ••♦)•( (COS  «Z» I ••♦! > AC1270 

GO  TO  130  AC12B0 

120  CALL  LILLET  (NUtIOPTtG«DELRAO.UICZtTITZiGAMA*KZRZ»TZ*CTAIN»RSWtALT  AC1290S 
1B.BLTB. ILWR.PPM.PPo.PPO* IERL)  AC1300 

IP  (IERL.NE.0)  GO  TO  420  AC1310 

PP-PPQ  AC 1320 

ZZ- 1 . 0-COI • 1 0 . 0«« ( ( PPM-PPQ ) / 1 0 . 0 ) *COS ( Z > -*4  AC 1 330 

GO  TO  130  AC1340 

130  IP  (ZZ.LE.0.0)  GO  TO  360  AC13S0 

DIRECT-10 .0* ALOGlO (ZZ>  AC1360 

SPLPQ-SPLNQI*LM*CA*PP*DIRECT  AC13T0 

AC 1300 

DIPOLE  CONTRIBUTION  AC1390 

AC1400 

LH*60.C«ALOG10(VJA6>  AC 14 10 

RTS-i.O/TS  AC 1420 

TEMPS- 1 0 . 0* ALOGlO (<  1 . 0-RTS) • ( 1 . 0-RTS) ) AC 1430 

CAa.lO.O*(2«NU*l)*ALOG10(OM)  AC1440 

IP  (BOPNO.EQ.l)  60  TO  140  AC14S0 

IP  (B0PN0.E0.2)  GO  TO  ISO  AC1460 

140  PP>10,0*ALOG10(DS*OS«OSP2**(NU-2))>20.0«ALOG10(TS)-10.0*ALOG10(GS)  AC14T0 
ZZ»1 .0* (C0I«TS*GS* ( ( 1 .O/OS) **2) • ( (COS (Z) ) **2) ) AC14S0 

GO  TO  160  AC1490 

150  PfaPPD  AC1S00 

ZZ>1.0*CD1*10.0«*( (PPH-PPD)/10.0)*COS(Z)*«2  AC1S10 

GO  TO  160  AC1520 

160  IP  (ZZ.LE.0.0)  GO  TO  360  AC1S30 

DIRECT- 1 0, 0«AL0GI 0 (ZZ)  AC1540 

SPLPO*SPLNOI«LH*TEMPS*CA*PP*OIRECT  AC 1550 

AC1560 

GO  TO  330  AC15T0 

AC1560 

••PREDICTION  INSIDE  CONE  OP  SILENCE**  AC1590 

AC1600 

170  CONTINUE  AC 16 10 

IND-IC  AC1620 

TZ»Z*57. 2957795  AC1630 

IP  (TZ.LT. 30.0. AND. BOPNO.EQ.l)  GO  TO  400  AC1640 

AC 1650 

IP  (BOPNO.EO.il  GO  TO  1B0  AC1660 

IP  (B0PN0.EQ.2)  GO  TO  260  AC1670 

AC1680 

CALCULATION  OP  UT/US  ANO  TRANSITION  POINT  TEMPERATURE  RATIO  TT  AC1690 

AC1700 

180  ONE>2.0*ETA1*VJAO/COS(Z)»TS-1.0«ETAI*ETAI*vjA0*VJA0*VJA0«0.2  AC1710 

TWO-1 ,2*ETAI«ETAI«VJA0*VJA0  AC1720 

THREE-(SIN(Z)/COS(Z) )##2  AC1730 

POUR-ONE-ONE-4. 0*TwO»TMREE  AC 1740 

IP  (POUR. LT. 0.0)  GO  TO  190  AC1750 

UTU5- (ONE-SQRT (POUR) ) / (2.0*TWO)  AC1760 
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GO  TO  200  AC1770 

190  UTUS*) °0.0  AC1780 

200  CONTINUE  AC1790 

C AC1800 

TT*( (1.0/COS(Z) )-(vJA0*UTUS*ETAI)»#*2  AC1810 

AC1820 

CALCULATION  OF  EXPONENTIAL  DECAY  AC1830 

AC 1840 

PMI*UTUS*ETAI  AC1850 

OE* ( (TJT0-1 ,0) /TT) ♦ (2,0*VJA0/ (SORT ITT) ) ) ♦ (0.2*VJA0*VJA0* < 1 .0-2. 0*P  AC1860 
1HI)/TT)  AC1B70 

GPHI«GPT(PHI)  AC1S80 

IF  (GPHI.EQ.0.0)  Go  TO  340  AC1890 

DEN*-1,0*GPHI*COS(Z)*COS(Z>*DE  AC1900 

AC191C 

Q* t SORT (ABS(KS) ) ) **3  AC1920 

Y*(4,0*Q)/(3.0*DEN)  AC 1930 

AA3*Y*SMDI*VJA0/DM  AC 1940 

IF  (AA3.GE.0.6)  GO  TO  240  AC1950 

INO-IT  AC1960 

IF  (AA3.LT. 0.0)  GO  TO  390  AC1970 

11*2  AC1980 

210  IF  ( AA3-X  (ID)  230,230.220  AC1990 

220  11*11*1  AC2000 

IF  (II.GT.7)  GO  TO  240  AC2010 

GO  TO  210  AC2020 

230  OO-DEC ( 1 1 > * ( (X(II)-AA3)/(X(II)-X(II-1)> ) • (DEC ( 1 1-1 ) -DEC (ID)  AC2030 

GO  TO  250  AC2040 

240  00*0 .391 52*EXP (-AA3) / (SORT (3.0*AA3*1 .0) ) AC2050 

250  DECAY-10. 0*ALOG10 (00)  AC2060 

GO  TO  260  AC2070 

AC2080 

QUADRUPOLE  CONTRIBUTION  AC2090 

AC2100 

260  LH>B0.0*ALOG10(VJA0)  AC2110 

CA»-10.0*(2*NU*3)*ALOG10(OM)  AC2120 

IF  (BOPNO.EO.l)  GO  TO  270  AC2130 

IF  (B0PN0.E0.2)  GO  TO  280  AC2140 

270  CONTINUE  AC2150 

P1*ABS(KS) ♦COS(Z)*COS(Z)  AC2160 

FFF»10.0*ALOG10(OSP2**(NU-2)*P1*P1/TS)  AC2170 

FFI*FFF*DECAY  AC2180 

ZZ*Pl/(COS(Z)*COS<Z) ) AC2190 

YY*1.0*CQI/(ZZ*ZZ)  AC2200 

GO  TO  290  AC2210 

280  CALL  LILLEY  (NU, I0PT.6. OELRAD,UICZ.TITZ»GAMA,KZRZ,TZ.ETAin,RSW.ALT  AC2220S 
1B.BLTB, ILWR.FPM.FPD.FPO, IERL)  AC2230 

IF  (IERL.NE.0)  GO  TO  42o  AC2240 

FFI-FPQ  AC2250 

YY*1,0*COI*10«0**( (FPM-FPQ) /1 0. 0 ) *COS ( Z) **4  AC2260 

GO  TO  290  AC2270 

290  IF  (YY.LE.0.0)  GO  tO  360  AC2280 

OIRECI*10,0*ALOG10(YY)  AC2290 

SPLP0*SPLNQ1«LH«CA*FFI*DIRECI  AC2300 

AC2310 

DIPOLE  CONTRIBUTION  AC2320 

AC2330 

LHH*60.0*ALOG10(VJA0)  AC2340 

RTS-1. 0/TS  AC2350 
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TEMP2- 1 0 . 0*ALOGl 0 ( ( 1 . 0-RTS) • ( 1 * 0-RTSi ) AC2360 

CAH*-10.0*C2*NU*l)*ALOGlO<OMJ  AC2370 

I F (B0PN0.E0.1)  GO  TO  300  AC2380 

IF  (B0PN0.E0.2)  GO  TO  310  AC2390 

300  FF*10.0*ALOG10(DSP2**(NU-2>*P1/TS)  AC2A00 

FFM*FF*DECAV  AC2*10 

VYM*1.0*CDI/ZZ  AC2420 

GO  TO  320  AC2A30 

310  FFH-FPO  AC2**0 

YYM»1.0«CDI*10.0**((FPM.FPD>/10.0)*COS<Z>**2  AC2A50 

GO  TO  320  AC2460 

320  IF  (YYH.LE.0.0)  GO  TO  360  AC2AT0 

OIRH»10.0*ALOG10(YyM)  AC2480 

SPLPD*SPLNDI*LHH*TFMP2*CAM*FFM*DIRN  AC2*90 

AC2500 

••AD01TI0N  OF  OUADrUPOLE  AND  DIPOLE  CONTRIBUTIONS**  AC2S10 

AC2S20 

330  SPL8(I)*10.0*ALOG10(10.0**(SPLPO/10.0)*10.0**(SPLPD/10.0))  AC2530 

GO  TO  *30  AC2540 

AC2S50 

FAILURE  CODE  STATEMENTS  (PACKAGE  B)  AC2S60 

AC25T0 

3*0  SPLB(I)»1.0  AC25B0 

SPLPO-O.O  AC2590 

SPLPO-O.O  AC2600 

GO  TO  *30  AC2610 

C AC2620 

350  SPL8(I)*2,0  AC2630 

SPLPO*0.0  AC26*0 

SPLPO-0.0  AC2650 

GO  TO  *30  AC2660 

C AC2670 

360  SPLB(I)*3.0  AC2680 

SPLPQ*0,0  AC2690 

SPLPO-0,0  AC2700 

GO  TO  *30  AC27 10 

C AC2720 

370  SPLB(I>**.0  AC2730 

SPLPO-O.O  AC2740 

SPLPD*0.0  AC2750 

GO  TO  *30  AC2760 

C AC2770 

380  SPLB(I>*5,0  AC27B0 

SPLPO-O.O  AC2790 

SPLPO-O.O  AC2800 

GO  TO  *30  AC2810 

C AC2820 

390  SPLB(I)*6.0  AC2B30 

SPLPO-O.O  AC28*0 

SPLPO-O.O  AC2850 

GO  TO  *30  AC2B60 

C AC2870 

*00  SPLB ( I ) *7,0  AC2880 

SPLPQ*0.0  AC2890 

SPLPO*0.0  AC2900 

GO  TO  *30  AC2910 

C AC2920 

*10  SPLB(I)>8.0  AC2930 

SPLPQ-0.0  AC29*0 


SPLP0»0.0 
00  TO  430 
420  CONTINUE 

SPLB ( I) "PLOAT ( I ERL) 
SPLPQ»0.0 
SPLPD-0.0 
430  CONTINUE 
RETURN 
ENO 


ACttSO 

AC2960 

AC29T0 

AC2900 

AC2990 

AC3000 

AC3010 

AC3020 

AC3030- 
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•DECK 

SELECT 

SUBROUTINE  SELECT  (NUtISS) 

AO 

10 

C 

AD 

20 

DIMENSION  IRQ (8) ,SH(28) .DELRAD (28.6) 

AD 

30 

DIMENSION  1WRT(B> 

AD 

40 

COMMON/FOUR/  A (16) 

AO 

50 

COMMON/FIVE/  B ( 1 6 ) 

AD 

60 

COMMON/SIX/  C ( 1 6 ) 

AD 

70 

COMMON/SEVEN/  D ( 1 0 ) 

AD 

80 

COMMON/EIGHT/  E (16) 

AD 

90 

COMMON/ANINE/  F ( 1 f ) 

AD 

100 

COMMON/Th I RTN/  R ( 16) 

AO 

110 

COMMON/EIGHTY/  T1 ( 16) .SD( 16,6) 

AD 

120 

C 

AD 

130 

COMmON/FOURI/  A 1 ( ?8 ) 

AD 

140 

COMMON/F I VE  1 / B1 (?0) 

AD 

150 

COMMON/SIX1/  Cl (?0) 

AD 

160 

COMMON/SEVEN1/  01(28) 

AD 

170 

COMMON/EIGHT1/  El (28) 

AD 

180 

COMMON/ AN I NE 1 / FI ,28) 

AD 

190 

COMMON/THIRTN1/  R i < 2B ) 

AD 

200 

COMMON/E IGHTY1/  SD1 (28,6) ,SDT1 (28,6) 

AD 

210 

C 

AD 

220 

COMMON/ONE/  SPLNQ ( 28 ) , CO ( 28 ) , SPLND ( 20) ,CD(2B) ,UCLUJ(28) ,XSD (28,6) 

AD 

230 

C 

AD 

240 

COMMON/TWO/  ETA (20)  ,XE (28) 

AD 

250 

DATA  PI  / 3.141593  / 

AD 

260 

DATA  SM  / 0.0316,0. 04, o.05,0. 063, 0.08, 0.1,0. 125, 0.16,0. 2,0. 25, 

AD 

270 

1 

0.316, 0.4^0, 5,0.63, 0.8, 1 .0, 1 .25, 1 .6, 2.0, 2.5, 3. 16,4. 0,5.0, 

AD 

280 

2 

6.3,8.0,10.0,12.5,16.0  / 

AO 

290 

C 

AD 

300 

ICOUNT»0 

AD 

310 

C 

AD 

320 

IF  (NU.E0.3)  GO  TO  40 

AD 

330 

C 

AD 

340 

DO  10  N« 1 , 28 

AD 

350 

ETA (N) ” A 1 (N) 

AD 

360 

SPLNQ ( N ) «B 1 (N) 

AD 

370 

CQ (N) «C 1 (N) 

AD 

380 

SPLNO(N)aOi (N) 

AD 

390 

XE (N) »E1 (N) 

AD 

400 

CD (N) *F 1 (N) 

AD 

410 

UCLUJ(N)aRi (N) 

AD 

420 

10 

CONTINUE 

AD 

430 

DO  30  1 3 1 , 4 

AO 

440 

00  30  Nal,28 

AD 

450 

IF  (ISS.EQ.l)  GO  TO  20 

AD 

460 

XSD(N,I)aS01 ( N , I ) 

AO 

470 

GO  TO  30 

AD 

480 

20 

XSO ( N, I ) «SDT 1 (N, I ) 

AD 

490 

30 

CONTINUE 

AD 

500 

GO  TO  90 

AD 

510 

c 

AD 

520 

to 

CONTINUE 

AD 

530 

DO  60  Na 1 , 28 

AD 

540 

IF  (N.LT.6.0R.N.GT.21)  GO  TO  50 

AD 

550 

ETA (N) »A (N-5) 

AD 

560 

SPLNQ (N) »B (N«5) 

AD 

570 

CQ(N)aC(N-5) 

AD 

580 
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SPLND (N) *0 (N-5)  AD  590 

XE (N) *E (N-5)  AD  600 

C0(N)«F(N-5)  AO  610 

UCLUJ (N)»R (N-5)  AD  620 

60  TO  60  AD  630 

50  CONTINUE  AO  6*0 

ETA(N)>0.0  AD  650 

SPLNQ(N>«0.0  AD  660 

CQ(N) “0.0  AD  670 

SPLND (N)bO.O  AD  680 

XE (N) >0*0  AD  690 

CD(N)-0.0  AD  700 

UCLUJ (N) *1,0  AO  710 

60  CONTINUE  AD  720 

DO  80  1*1,*  AO  730 

DO  80  N*1 ,28  AD  7*0 

IF  (N.LT.6.0R.N.GT.2I)  GO  TO  70  AD  750 

XSD (N« I ) ■ SO (N-5, I ) AD  760 

GO  TO  80  AO  770 

70  XSD(N.I)*0.0  AD  780 

80  CONTINUE  AD  790 

C AO  BOO 

90  CONTINUE  AO  810 

IF  (ISS.EQ.O.OR.ISS.EO.l)  GO  TO  150  AD  820 

READ  (5.200)  ( IRD ( I ) . I»1 .8)  AD  830* 

DO  100  1*1.8  AD  8*0 

IF  (IRD(I).EO.O)  GO  TO  100  AD  850 

I COUNT* I COUNT* 1 AD  860 

IWRT ( ICOUNT) *1  AD  870 

100  CONTINUE  AD  880 

IF  (IRD(l) .EO.l)  READ  (5.210)  (SPLNO (N) »N*1 .28)  AD  890* 

IF  (IR0(2) .EO.l)  RE*0  (5.210)  (CQ(N) »N*1 .28)  AD  900* 

IF  (IRD(3) .EO.l)  READ  (5.210)  SPLND (N) »N*1 ,28)  AD  910* 

IF  (IRD(*) .EO.l)  RE*0  (5.210>  (CO(N) .N-1.28)  AD  920* 

IF  (IR0(5) .EO.l)  READ  (5.210)  (ETA (N) ,N*1 ,28)  AD  930* 

IF  ( IRO (6) .£0, 1 ) R£AO  (5,210)  (XE (N) ,N*1 ,28)  AD  9*0* 

IF  ( IRD ( 7) .EO.l)  READ  (5,210)  (UCLUJ (N) ,N-1 .28,  AD  950* 

IF ( IRD (8) .EQ.O)  GO  TO  150  AD  955 

00  120  JJ«1.*  AD  960 

IF  (IRD(P) .EO.l)  READ  (5,210)  (OELRAD (N,JJ) ,N*1 ,28)  AD  970* 

DO  110  N*1 ,28  AD  980 

XSD(N,JJ)*PI*SM(N)*DELRAD<N,JJ)  AO  990 

110  CONTINUE  A01000 

120  CONTINUE  AD1010 

IF  (IRD (8) .NE.2)  GO  TO  150  AD1020 

DO  130  N«l,28  ADI 030 

XSRJ»2.0/SQRT'0.02i*SM(N)*SM(N) ♦0,057*SM(N) ) ADI  0*0 

OELRAD (N, 1 )»XSRJ/7, 616559  AD1050 

IF  (XSRJ.GT. 13.85)  OELRAD (N, 1 )■( 1 .0*0.55* (XSRJ-13. 85) / (26,0-13.85)  AD1060 
1 > *1 . 818535  A01070 

130  CONTINUE  AD1080 

FAC  1*0. 98**0. 25  AD1090 

FAC2»1.77**0.25  ADI100 

FAC3*2.209**0,25  AD1110 

F AC**3. 330**0 • 25  A01120 

00  1*0  N«It28  ADI  130 

OELRAD (N. 2) *DELRAD (N, 1 ) *FAC2  ADI  1*0 

XSD(N,2)>PI*SH(N)*0ELRAD(N,2)  ADI  150 

OELRAD (N. 3) >DELRAD (N, 1 ) *FAC3  ADI  160 
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XSD (N,3) »PI*SM (N) «DELRAD (N»3)  AD1170 

DELR4D (N, 4) ■OELRAO  <N« 1 ) »FAC4  ADI 180 

XSD(N,4)aPiaSM(N)*DELRAD(N,4>  ADI 190 

OELRAO IN, 1 ) aDELRAD  <N, 1 ) *FAC1  A01200 

XSD(N,l>aPI*SM(N)»DELRAD(N»l)  AD1210 

140  CONTINUE  AO 1220 

150  CONTINUE  AD1230 

IF  (IRO(B) .NE.O)  GO  TO  170  A01240 

00  160  J Ja 1*4  AD1250 

00  160  N* 1 f 28  AD1260 

OELRAD(N,JJ)axSO(N,JJ>/(PiaSM(N) ) AD1270 

160  CONTINUE  AD1280 

170  CONTINUE  AO1290 

WRITE  <6.220)  AD1300* 

IF  (ICOUNT.EQ.O)  WRITE  (6.230)  AD1310* 

IF  (ICOUNT.GT.O)  WRITE  (6.240)  ( IWRT ( I ) » !■!  , 1COUNT)  AD1320* 

IF  ( IRQ (8) .EQ.2)  WRITE  (6,250)  A01330* 

WRITE  (6,260)  (SM (N) . N>1 , 14)  A01340* 

WRITE  (6,270)  (SPLnQ(N) .Nal,14)  AD1350* 

WRITE  (6.280)  (COIN) ,Nai,i4)  AD1360* 

WRITE  (6,290)  (SPLNO(N) ,Nal,l4)  AD1370* 

WRITE  (6,300)  (CO(N) ,Nai,i4)  A01380* 

WRITE  (6.310)  (ETA(N) ,Nal,14)  A01390* 

WRITE  (6.320)  (XE(N) ,Nal,14)  A01400* 

WRITE  (6,330)  (UCLUJ(N) ,N«1,14)  AD1410* 

DO  180  JJal,4  AOI420 

WRITE  (6.340)  (OELRAD (N, JJ) ,Nal , 14)  AD1430* 

180  CONTINUE  A01440 

WRITE  (6.350)  (SM (N) ,NaiS, 28)  AD1450* 

WRITE  (6.270)  (SPLNQ(N) ,Nal5.28)  AD1460* 

WRITE  (6,280)  (COIN) ,Na)5,28)  A01470* 

WRITE  (6.290)  (SPLND(N) ,Nal5,28)  A01480* 

WRITE  (6,300)  (CO (N) ,N«15»28)  AD1490* 

WRITE  (6.310)  (ETA(N) ,NalS,28)  AD1S00* 

WRITE  (6,320)  ( XE (N) ,N«1S»28)  AOISIO* 

WRITE  (6.330)  (UCLUJ(N) ,Nal5,28)  AD1520* 

00  190  JJal,4  A01530 

WRITE  (6,340)  (DELRAD(N.JJ) .NalS.28)  A01540* 

190  CONTINUE  AD1550 

RETURN  A01560 

C A01570 

200  FORMAT  (1615)  AD1580 

210  FORMAT  (8F10.1)  A01590 

220  FORMAT  ( 1 HI  »44X • "MIXING  NOISE  SOURCE  ANO  MEAN  FLOW  CONSTANTS")  A01600 

230  FORMAT  </,52X."*  STANDARD  DATA  VALUES  USEO  •••>  A01610 

240  FORMAT  </,44X,i<USER  INPUT  VALUES  FOR  PARAMETERS" .8 ( IX, 1 1 ) ) A01620 

250  FORMAT  (1X."S0URCE  LOCATION  MODEL  USEO  , WITH  SIGMA  ■ 13. 5 , "."TO  A01630 

1 CALCULATE  DELTA/RJ" ,/, 1 X ," (T J/TO) aaO ,25  DEPENDENCE  "."ASSUMED  . A AD1640 
2T  STANDARD  TEMPERATURES  0.98.1.77,2,209,3,33")  A01650 

260  FORMAT  <///, 1X,»SM",7X, 14F7.3)  AD1660 

270  FORMAT  ( /, 1 X,"SPLQ».5X, 14F7.2)  AD1670 

280  FORMAT  (/,1X."AXWT0".4X,14F7.2)  AD1680 

290  FORMAT  (/, 1X,"SPLD",5X, 14F7.2)  A01690 

300  FORMAT  (/,1X,"AXWT0",4X,14F7.2)  A01700 

310  FORMAT  (/» 1X«"VS/VJ",4X, 14F7.2)  AD1710 

320  FORMAT  ( / , 1X,»VC/V J",4X, 14F7.2)  AO1720 

330  FORMAT  < /, 1 X,»VMAX/VJ" »2X, 14F7.2,/)  A01730 

340  FORMAT  (IX, "DELTA/RJ", IX, 14F7. 2)  AD1740 

350  FORMAT  ( ///, 1X,"SMh ,7X, 14F7.2)  AD1750 

END  AD1760- 
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SUBROUTINE  DOPPLE  (NUiSM,Z.TStGS»DS.OMtS,TZ,EI »ETAI .RQOA.PODt ZM.TO 

AE 

10 

IF.VJAOiTJTO.G) 

AE 

20 

COMMON/TWO/ETA (28) ,E(28) 

AE 

30 

c 

AE 

40 

c 

calculation  of  dm  ano 

AE 

50 

c 

AE 

60 

c 

EI« INTERPOLATED  E 

AE 

70 

c 

ETAI-INTERPOLATED  ETA 

AE 

80 

c 

AbALPHA 

AE 

90 

c 

BbBETA 

AE 

100 

c 

6S-GAMMA  RATIO  GS/GO 

AE 

no 

c 

TSbSOURCE  TEMPERATURE  RATIO  TS/TO 

AE 

120 

c 

AE 

130 

c 

AE 

140 

IF  (NU.NE.3)  GO  TO  30 

AE 

150 

IF  (SM.LT, 3. 16)  GO  TO  10 

AE 

160 

EIb0.6 

AE 

170 

ETAI«0 .6 

AE 

180 

GO  TO  70 

AE 

190 

10 

IF  (SM.GT.0.1)  GO  TO  20 

AE 

200 

EI-0.8 

AE 

210 

ETAI«0,5 

AE 

220 

GO  TO  70 

AE 

230 

20 

SMI 000"SM*1 000 

AE 

240 

YbALOGIO(SMIOOO) 

AE 

250 

Xb10,0*Y-14.0 

AE 

260 

GO  TO  60 

AE 

270 

30 

IF  (SM.LT.16.0)  GO  TO  40 

AE 

280 

EI»0.6 

AE 

290 

ETAI-0.6 

AE 

300 

GO  TO  70 

AE 

310 

40 

IF  (SM.GT. 0.0316)  GO  TO  50 

AE 

320 

EIbI.O 

AE 

330 

ETAIbO.3 

AE 

340 

GO  TO  70 

AE 

350 

50 

SMI COO-SM* 1000 

AE 

360 

YBALOGIO(SMIOOO) 

AE 

370 

Xb10.0*Y-14.0 

AE 

380 

60 

CONTINUE 

AE 

390 

JX-X 

AE 

400 

J1-JX*1 

AE 

410 

EX-X-JX 

AE 

420 

EIbE(JX)*EX*(E(J1)-E(JX> ) 

AE 

430 

ETAI-ETA { JX> *EX» (Eta ( Jl) -ETA (JX) ) 

AE 

440 

c 

CALCULATION  OF  RADIATION  ANGLE  TZ (DEGREES) 

AE 

450 

c 

AE 

460 

70 

POSbI ,0/SQRT (0.057bSM*0.021*SM«SM) 

AE 

470 

ROOAbSQRT (ROD«ROD*POS«POS-2.0*ROO*POS*COS(ZM) ) 

AE 

480 

XXB (ROO*ROO*ROOA*ROOA-POS»POS) / (2,0*ROO*RODA) 

AE 

490 

aabsort<i,o-xx*xx) 

AE 

500 

W«ATAN2 (AAf XX) 

AE 

510 

Z>W»ZM 

AE 

520 

TZb2*57, 2957795 

AE 

530 

c 

AE 

540 

c 

CALCULATION  of  GAMMAS 

AE 

550 

c 

AE 

560 

0-0.073 

AE 

570 

TSM«1 ,0* (0»6* (TJT0-1 ,0) ) • (VJA0*VJA0*(0*6-0.6*0,6) *0.2) 

AE 

580 

6A 
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IF  (TSM.LT. 0.999)  D«0.034  AE  590 

TS»1.0*(TSM-1.0)/((0.98*0/(SM*SH))»«0.25)  AC  600 

T0C»< <Tyr-32.0)«5.0>/9.0  AC  6J0 

T0K-T0C. 273.0  AC  620 

T»TS*T0K  AC  630 

G0«1. 421- (T0K/1 1800.0) ♦ (EXP (-ABS(T0K-450,0)/200.0> /B0. 0)  AC  640 

IF  (T0K.LE. 290.0)  GO-1.402  AC  650 

Gal.42l-(T/11800.0)MEXP(-ABS(T-450.0)/200.0)/B0.0>  AC  660 

IF  (T.LE. 290.0)  G-1.402  AE  670 

GS-G/G0  AC  680 

C AE  690 

A«0.2*TS**1.2  AE  700 

IF  (NU.EQ.3)  A«0.2*TS**0.6  AE  710 

B«0.55*T5**0,2  AE  720 

IF  (NU.EQ.3)  8«0,4*T5**0.2  AE  730 

DS«1.0-ETAI*VJA0»COS(Z)  AE  740 

DC«1 ,0-EI*VJA0*COS(Z)  AE  750 

AE  760 

CALCULATION  OF  MOD IF  I EO  DOPPLER  FACTOR  Dm  AND  STROUHAL  NUMBER  S AE  770 

AE  780 


*•*  A NEGATIVE  SQUARE  ROOT  ARGUMENT  ERROR  CAN  OCCUP  IN  THE  NEXT 
STATEMENT.  FOR  EXAMPLE,  AT  HIGH  TEMPERATURES.  THIS  PROBLEM  DOES 
NOT  ARISE  IF  OM  IS  GIVEN  PY 


OM=SQPT (DC*DC*8*B*vJAi*VJAO*COS(2) *COS(Z) 

I *A«A*VJAO*VJAn*AHS(OS*DS/(TS*GS)-COS(Z)*COS(Z) ) ) 


THIS  REVISED  DEFINITION  OF  DM  WAS  SUGGESTED  BY  THE  INVESTIGATION 
INTO  TRANSVERSE  NCNCOmPACTNESS  EFFECTS  WITH  NUMERICAL  lilley 
EQUATION  SOLUTIONS,  DESCRIBED  IN  SFCTION  2. 1.5. 2.  HOWEVER  THE 
SHEAR  LAYER  THICKVESS  PARAMETER  SHOULD  «fc  FIRST  RE-OPTIMISED.  WITH 
THE  RE VI SEO  OM,  BEFOPt  THIS  CHANGF  IS  CONSIDERED  FOP  GENERAL 
PREDICT  ID'1  PURPOSES. 


DM»SORT(DC*DC*B*B»vJAO«VJAO*COS(Z)«COS(2) *A4A«VJA0WVJA0»(0S«0S/ITS  ae 
l»GS)-COS(Z)«COS(Z))) 

S«SM/0M  « 

RETURN 

ENO  « 


790 

800 

810 

820 

830- 
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•DECK  GPT 


FUNCTION  GPT (PHI) 

AF 

10 

AF 

20 

THIS  FUNCTION  CALCULATES  THE  GRADIENT  OF  VELOCITY  PROFILE***** 

AF 

30 

AF 

40 

DATA  RPI » PI/1 .772*539*3, 1*1593/ 

AF 

50 

IF  (PHI. LT. 0.0. OR. PHI. GT. 1.0)  GO  TO 

10 

AF 

60 

GPT-0.0 

AF 

70 

IF  (PHI. LT. 0.0001. OR. PHI. GT. 0.9999) 

RETURN 

AF 

60 

X*0,0 

AF 

90 

DO  10  1*1.20 

AF 

100 

OEL*0.5*(1,0-ERF(RPI*X) )-PHI 

AF 

110 

OELP*-EXP(-X*X*PI) 

AF 

120 

DIF-OEL/OELP 

AF 

130 

X-X-DIF 

AF 

140 

IF  (ABS(OIF) .LT. 0.0001)  GO  TO  20 

AF 

150 

10 

CONTINUE 

AF 

160 

STOP  7 

AF 

170 

20 

CONTINUE 

AF 

160 

GPT-0ELP 

AF 

190 

RETURN 

AF 

200 

ENO 

AF 

210 
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• • 

AG 

10 

SUBROUTINE  LILLEY 

AG 

20 

AG 

30 

PURPOSE 

AG 

40 

TO  SOLVE 

THE  LILLEY  EQUATION  WITH  SPECIFIED  MONQPOLE* DIPOLE 

AG 

SO 

AND  OUAORUPOLE 

source  distributions  in  an  AXISYMMETRIC, 

AG 

60 

PARALLEL' PLOW  FIELD  AT  A GIVEN  FREQUENCY  AND  OBSERVER  ANGLE 

AG 

70 

AG 

BO 

USAGE 

AG 

90 

CALL  LILLEY (NU. 

I OPT, I W.DELRAD, UICZ, TITZ, GAMMA, KZRZ, THETZ, 

ag 

100 

etain. 

RSW.ALTBt 

bltb, ILWR,FPm,FPD»FPQ, ierd 

AG 

110 

AG 

120 

DESCRIPTION  OF  PARAMETERS 

AG 

130 

••  INPUT 

AG 

140 

IOPT 

• 

■1  RING  SOURCE,  RADIUS  SPECIFIED  BY  ETAIN 

A6 

ISO 

■2  radially  distributed  source, width  rsv 

AG 

160 

-3  AS 

FOR  IOPT-2  BUT  WITH  RADIAL-AZIMUTHAL 

AG 

170 

NONCOMPACTNESS  SPECIFIED  BY  ALTB.BLT8 

AG 

180 

IV 

• 

OUTPUT 

file  indicator 

AG 

190 

DELRAO 

m 

VORTICITy  THICKNESS  OF  VELOCITY  PROFILE  NORMALISED 

AG 

200 

BY  JET  NOZZLE  RADIUS.  0.LT.DELRAD.LE.9 

AO 

210 

UICZ 

m 

center 

-LINE  VELOCITY  NORMALISED  BY  AMBIENT  SOUND 

AG 

220 

SPEpD. 

0.LE.UICZ.LE.3 

AG 

230 

TITZ 

m 

CENTER 

-LINE  STATIC  TEMPERATURE  NORMALISED  BY 

AG 

240 

ambient  temperature.  0.LT.TITZ.LE.9 

AG 

250 

GAMMA 

m 

RATIO 

OF  SPECIFIC  HEATS*  1 .LE.GAMMA.LE. 1 .5 

AG 

260 

KZRZ 

m 

2*pi*prequency*nozzle  radius/ambient  sound  speed 

AG 

270 

0.LT.KZRZ.LE.20 

AG 

280 

THETZ 

m 

PAR-FIELD  OBSERVER  ANGLE  TO  DOWNSTREAM  JET  AXIS 

AG 

290 

O.LT. THETZ.LT. 180 

AG 

300 

etain 

m 

FLOW  VELOCITY  AT  SOURCE  RADIUS  VS/VMAX 

AG 

310 

STANDARD  values  are  tabulated  below 

AG 

320 

ISRl 

VS/VMAX-ETAIN  (ETA-VS/VJ) 

AG 

330 

1 

0.990 

AG 

340 

2 

0.982 

AG 

350 

3 

0,969 

AG 

360 

4 

0.948 

AG 

370 

5 

0.919 

AG 

380 

6 

0.877 

AG 

390 

7 

0.824 

AG 

400 

8 

0.757 

AG 

410 

9 

0.679 

AG 

420 

10 

0.670 

AG 

430 

11 

0.663 

AG 

440 

12 

0.600 

AG 

450 

13 

0.592 

AG 

460 

1<* 

0.500 

AG 

470 

IS 

0.408 

AG 

480 

16 

0.321 

AG 

490 

17 

0.243 

AG 

500 

18 

0.176 

AG 

510 

19 

0.123 

AG 

520 

20 

0.081 

AG 

530 

21 

0.0S2 

AG 

540 

22 

0.031 

AG 

550 

■x  ■ 

23  w 

0.018 

AG 

560 

24 

0.010 

AG 

570 

RSW 

m 

turbulence  intensity  radial  half  width 

AG 

580 

1 
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ALTB 

SLTB 


• THESE  COEFFICIENTS  SPECIFY  THE  radial-azimuthal 

• COHERENCE  LENGTH  SCALE  LTBaALT8»X«8LTB 


AG  600 
AG  610 


ILWR 

IERL 


SET  ILWR>1  IF  OUTPUT  REOUIRED.  OTHERWISE  lLWR«0 


- ERROR  flag 


■0 

9 


••OUTPUT 

FPM 

FPO 

FPQ 


NO  ERRORS 

CRITICAL  RADIUS  TOO  SMALL 


FLOW  FACTOR  FOR  MONOPOLE  SOURCE  DISTRIBUTION 

FLOW  FACTOR  FOR  S.I.  OIPOlE  SOURCE  DISTRIBUTION 

FLOW  FACTOR  FOR  S.I.  OU*DRUPOLE  SOURCE  DISTRIBUTION 
(S.I.  - STATISTICALLY  ISOTROPIC* 


REMARKS 

AXIAL  SOURCE  CONVECTION  AND  COHERENCE  EFFECTS  ARE  NOT 
INCLUDEO  HERE  BUT  HAY  BE  SIMULATED  THROUGH  A MODIFIED 
DOPPLER  FREQUENCY  SHIFT  WITH  ANGtE, 


SUBROUTINES  ANO  FUNCTION  SUBPROGRAMS  REQUIREO 
DSETUP 


SUB  2 

AXIAL 

SLOC 

VELT 

ERF 

CRIT 

RABC 

CBESLI 

CBESL2 

IDERY 

HPCL 

AFCT 

FCT 

OUTP 

COEF 

TRANS 

WRCAL 

TCON 

TSIGN 

RADCSD 

INTRAP 

SRPSD 

BESI 

QTFG 


ERROR 

0 

1 

2 
3 


STOPS 


FLOW  PARAMETER  OUTSIDE  ALLOWED  RANGE 
FREQUENCY  OR  ANGLE  OUTSlOE  ALLOWED  RANGE 

integration  failure  ihlf-u 
number  of  integration  steps  EXCEEDS  DIMENSION 
OF  arrays  YMI.YPU(EOUIVALENCED)  first  mpcl  call 
ditto  thiro  and  fourth  Calls 
ditto  fifth  CALL 

•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••A*** 

SUBROUTINE  LILLET  (NU.lOPTtlW* DCLRAD.UlCZ.TlTZtGAMMA.KZRZ.THETZtET 
1AIN.RSW* ALTB.BLTB.lLWR.FPM.FPO.FPO. IERL) 


4 

5 


AG  620 
AG  630 
AG  640 
AO  6S0 
AG  660 
AO  670 
AG  660 
AG  690 
AG  700 
AG  710 
AG  720 
AG  730 
AG  740 
AG  750 
AO  760 
AG  770 
AG  760 
AG  790 
AG  BOO 
AG  BIO 
AG  620 
AG  B30 
AG  640 
AG  650 
AG  660 
AG  670 
AG  880 
AG  690 
AG  900 
AG  910 
AG  920 
AG  930 
AG  940 
AG  950 
AG  960 
AG  970 
AG  980 
AG  990 
AG1000 
AG1010 
AG1020 
AG1030 
AG1040 
AG1050 
AG1060 
AG1070 
AG10B0 
AG1090 
AG1100 
AG1110 
AG1120 
AG1130 
AG1140 
AG1150 
AO 11 60 
AG1170 
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DIMENSION  0(50) (10(50)  AG1180 

C0MM0N/F0URTN/US (24)  AG1190 

REAL  KZRZ  AG1200 

IERL-0  AG1210 

GO  TO  (10.60*70) • I OPT  AG1220 

10  CONTINUE  AG 1230 

AG1240 

FIND  NEAREST  STANDARD  SOURCE  RADIAL  POSITION  AG1250 

DO  20  1-1,24  AG1260 

ISRL-1  AG1270 

IF  (ETAIN.GT.US(I) ) GO  TO  30  AG1280 

20  CONTINUE  AG1290 

30  CONTINUE  AG1300 

CALL  OSETUP  <NU,IOPT,lW,DELRAD,UICZ.TlTZ, GAMMA, KZRZ, TMETZ.ISRL. ETA  AG1310S 
I1N,RSW,ALTB,BLT8,D,ID,ILWR)  AG1320 

CALL  SUB2  (D,IO>  AG1330S 

FPM»0 (31 ) AG1340 

FP0>0(32)  AG1350 

FP0>0(33)  AG1360 

IF  (ISRL.LE.l)  GO  TO  40  AG1370 

F ACL* (ETA IN-US ( I SRL-1 ) ) / (US ( ISRL) -US ( ISRl-1 ) ) AG1380 

FPM-D (41 ) ♦ (FPM-D (41 ) ) «FACL  AG1390 

FPD-0  (42)  ♦ (FPD-0  (42) ) <*FACL  AG1400 

FPQ»0 (43) ♦ (FPQ-0 (43) ) *FACL  AG1410 

40  CONTINUE  AG1420 

IERL>I0(41)  AG1430 

IF  (ILWR.EQ.O)  GO  TO  50  AG1440 

WRITE  ( IW,90)  IERL,FPM,FPD,FPG  AG1450* 

SO  CONTINUE  AG1460 

RETURN  AG1470 

60  CONTINUE  AG1480 

TO  CONTINUE  AG1490 

ISRL-0  AG1 500 

CALL  OSETUP  (NU,IOPT,lW,DELRAO,UICZ,TlTZ, GAMMA, KZRZ, THETZ,ISRL»ETA  AG1510S 
1IN,RSW,ALTB,BLTB,0,ID,ILWR)  AG1520 

CALL  SUB 2 (D, ID)  AG1S30S 

FPMaD (36)  AG1540 

FPD"D (37)  AG1550 

FPQaO (38)  AG1560 

IERL*IO(41)  AG1570 

IF  (ILWR.EQ.O)  GO  TO  80  AG1580 

WRITE  (IW,90)  IERL,FPM,FPD,FPQ  AG1590* 

80  CONTINUE  AG1600 

RETURN  AG1610 

C AG1620 

90  FORMAT  (1X,I5,3E13.6)  AG1630 

ENO  AG1640- 
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•OECK  DSETUP 

SUBROUTINE  DSETUP  (NU>IOPT,IW,DELRAD.UlCZ,TITZ.GAMMA.KZRZ,THETZ.IS  AH  10 

1RL.ET4IN.RSW.ALT8.BLT8.D. 10. ILWR)  AH  ZO 

REAL  KZRZ  AH  30 

DIMENSION  0(1)*I0(1)  AH  40 

OATA  RTPI  / 2.506628  / AH  SO 

ITEST>0  AH  60 

PI-3.141593  AH  TO 

X1>7.616559*0ELRA0  AH  80 

IF  (XI. GT. 13.85)  Xl>l3.85*(DELRAD/l, 818535-1. 0)*(26.&-13,85)/0. 55  AH  90 

ANG-THETZ-PI/180.0  AH  100 

IF  (DELRAD.LE.0.0.OR.0ELRAD.GT.9.0)  GO  TO  70  AH  HO 

IF  (UICZ.LT.0.0.0R.UICZ.GT.3.0)  GO  TO  TO  AH  120 

IF  (TITZ.LE.O.O.OR.TITZ.GT.9,0)  GO  TO  TO  AH  130 

IF  ( GAHHA.LT • I.O.OR.GAHmA.GT, 1 .5)  GO  TO  70  AH  140 

IF  (KZRZ. LE.O.O.OR.KZRZ.GT. 20,0)  STOP  1 AH  ISO 

IF  (THETZ.LE.0.0.OR.THETZ.GE.180.)  STO?  1 AH  160 

D ID ■0.02-X1/8.0  AH  170 

D(2)>.001  AH  180 

D<3)>0.0  AH  190 

0(4>>0.02  AH  200 

D(S>>0.0  AH  210 

D(6)>0.12*X1/B.0  AH  220 

0 (7) >,005  AH  230 

0(8) >GAMM4  AH  240 

0 (9) -0.0  AH  250 

D(10)*0.0  AH  260 

IF  (IOPT.EQ.l)  GO  TO  20  AH  270 

RTEST>0,5*Xl*RSW/0. 832554  AH  280 

IF  (RTEST.LT. 0(D)  ITEST-l  AH  290 

IF  (RTEST.LT. 0(1) ) GO  TO  20  AH  300 

D(9)>RSV  AH  310 

RS-0.0  AH  320 

IF  (ETAIN. LT. 0.0001. OR. ETAIN.GT, 0.9999)  GO  TO  10  AH  330 

IF  (OELRAO.LE. 1.818535)  RS»1.O»OELRAO*(SORT(A0S(ALOG(-GPT(ETAIN) ) ) AH  340 

1)*0. 022*13. 5/S0RT(PI))  AH  350 

IF  (OELRAD.GT. 1.818535)  RS*OELRAD*SQRT(2.0*EXP(-1.0)*ABS(ALOG(ETAI  AH  360 

IN)))  AH  3T0 

10  CONTINUE  AH  380 

RSC- ( RS- 1 . 0 ) /X 1 AH  390 

D(10)«RSC  AH  400 

20  CONTINUE  AH  410 

0(11) -KZRZ  AH  420 

D(12)»UICZ  AH  430 

D(13)*TITZ  AH  440 

0(14)>COS(ANG)  AH  450 

D(15)>SIN(ANG)  AH  460 

D ( 16) *X1  AH  4T0 

D(1T)»0.0  AH  480 

D ( 18) *0.0  AH  490 

0(19)*0.0  AH  500 

D(20)*0.0  AH  510 

D(21)-1.0  AH  520 

0(22) *1.0  AH  530 

0(23) *0.0  AH  540 

0(24) >0.0  AH  550 

D(25)>0*0  AH  560 

D (26) >0.0  AH  5T0 

GO  TO  (30.40.50).  IOPT  AH  580 


30  CONTINUE  AH  590 

D (26) *0,0  AH  600 

SO  TO  60  AH  610 

AO  CONTINUE  AH  620 

0(26)«0.0  AH  630 

I F (0(1). GE. 10. 0*0. 54X1*0(9)/0. 832554)  ITEST-1  AH  640 

IF  (D(l).GE. 10. 0B0.5*Xl*D(9)/0. 832554)  GO  TO  60  AH  650 

0(26) >D(1)  AH  660 

GO  TO  60  AH  670 

50  CONTINUE  AH  680 

SLTB»(ALTB»X1*8LTB)/RTPI  AH  690 

IF  (SLTB.LT.O ( 1 ) ) lTEST-1  AH  700 

IF  (SLTB.LT. 0(1) ) GO  TO  60  AH  710 

0(26)»SLTB  AH  720 

60  CONTINUE  AH  730 

10(1 >»5  AH  740 

10 (2) »IW  AH  750 

10(3)B1  AH  760 

ID (4) «NU  AH  770 

I0(5)«0  AH  780 

I0(6)«0  AH  790 

IO(7)*l  AH  800 

ID (8) "0  AH  810 

I0(9)>0  AH  820 

ID(10)«12  AH  830 

ID ( 1 1 ) >0  AH  840 

ID ( 12) B0  AH  850 

10(13) B0  AH  860 

ID ( 14) B0  AH  870 

ID ( 15) B0  AH  880 

ID ( 16) >82  AH  890 

10 ( 17) “ISRL  AH  900 

ID ( 18) »0  AH  910 

ID (25) B0  AH  920 

ID(26)BILWR  AH  930 

IF  ( I OPT, EQ. 2, OR, I OPT. EQ, 3. AND. I TEST ,E9t 0)  10 (25> B1  AH  940 

IF  ( I TEST.NE , 0 ) WRITE  (IW.80)  RSW.ALTBfBLTB  AH  950* 

RETURN  AH  960 

70  CONTINUE  AH  970 

WRITE  ( I W,90)  OELRAO.UICZ.TITZ. GAMMA  AH  980* 

STOP  AH  990 

C AH1000 

80  FORMAT  (1X,«RSW,ALTB,BLTB»,3E13.6,»T00  SmALL*OPTION  1 ASSUMED”)  AH1010 

90  FORMAT  (IX. "FLOW  PARAMETERS  OUTSIDE  ALLOWED  RANGE".4El3.6)  AH1020 

END  AH1030- 
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•OCCK  SUM 

SUBROUTINE  SU82  (0,10)  A!  10 

EXTERNAL  FCT.AFCT.OUTP  AI  20 

DIMENSION  0(1) *10(1)  AI  30 

DIMENSION  PRMT (8) • Y (4) «DERY (A) ,AUX ( 16,4) ,A (4,4) ,X0S(60) , AMP(3)  AI  *0 

DIMENSION  APLUOjS)  »IER(2),TIJ(7  #40)  * YmI  (450,5)  *TX  (?)  AI  SO 

DIMENSION  PRS(Ao) «PQ(40) «PO(40)  AI  60 

DIMENSION  PA (40)  AI  70 

COMPLEX  CMPLXtCSORT  AI  00 

COMPLEX  JSR.CAMp(2),BETl,BET2,STPl,STP2,RADM,BCNS»RPRES  AI  90 

COMPLEX  KR0,KR0,BCWS,CPLUG(2)»TRN»TARn  AI  100 

COMPLEX  ST1 (40) ,BE1 (40) tBETIO  AI  110 

COMPLEX  ST2(40),BE2(40).BET20  AI  120 

COMPLEX  TRFN.TFFN  AI  130 

COMPLEX  SAV  AI  140 

REAL  KW.M,M1,KWS  AI  ISO 

COMMON  YPU (650t5)  AI  160 

YPU  IN  OUTP.RAOCSO  AI  170 

NMP  BELOW  IS  MAX  FIRST  OIMENSION  AI  ISO 

NMP  IN  YMI  ABOVE  AI  190 

COMMON/CI/  IR» IWtNOUT • I CHECK  AI  200 

COMMON/BJ/  M,KWaCANG«PI ,BV»CV,TJR,G  AI  210 

C0MM0N/CRIT/lCC,RCfXMC(16)»XTC(16)»TCR  AI  220 

COMMON/BN/  NGEO.NCJ.NUT  AI  230 

COMMON/ER/  IERX  A I 240 

C FIX  STEP  SIZE  MOO  AI  250 

COMMON/FIX/  JFIxSS  AI  260 

COMMON/  FJET/IFj,FJUT.FJTT,FJRT»FJBV»FJCV  AI  270 

COMMON/BUG/  IDBUG  A I 280 

COMMON/STYPE/  MTYPS  AI  290 

COMMON  /SRDCSD/  SAV (450)  AI  300 

EQUl VALENCE ( YPU (lil),YMI(l,l))  AI  310 

N0IM«4  AI  320 

ICC>3  AI  330 

NMP-650  A I 340 

PI"3. 141593  AI  350 

TEMPm,2s  A I 360 

JSR«<0..1.)  AI  370 

00  10  JJ-1'S  AI  380 

10  PRMT ( JJ) «0,  AI  390 

00  20  1*1 t 16  AI  400 

20  AUX ( I • 1 ) *0,0  AI  410 

C AI  420 

PRMT (3) *•0(1)  AI  430 

PRMT (4) *0 (2)  AI  440 

PRMT (7) *0 ( 3)  AI  450 

0FC*0 (4)  AI  460 

R0X*0(S)  AI  470 

RC*0 (6)  AI  480 

EC0N*D (7)  AI  490 

G*0 (8)  AI  500 

RSW*0 (9)  AI  510 

RSC*0 (10)  AI  520 

KW*0 (11)  AI  530 

M*0(12)  AI  540 

TJR*0 (13)  AI  550 

CANG*0 (14)  AI  560 

SANG*0 ( 15)  AI  570 

Xl*0 (16)  AI  580 
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BV-D(l7) 

TC0R-DU8) 

DC0R-DU9) 

F JUT-0120 ) 

FJTT-DI21) 

FJRT-DI22) 

F JBV-D<23> 

FJCV-0(24) 

F JFF  >0(25) 

IB-1012) 

NGEO-ID(3) 

MTYPS-IO  (4) 

NUT-ID (5) 

IERX-ID (6) 

IHX-IO (7) 

I WB- 10(8) 

JFIXSS-I0(9) 

JCC-ID (10) 

I SG-ID (11) 

IOBUG-ID (12) 

NSL0X-IDU3) 

NSLO-ID ( 14) 

NCJN-ID ( 15) 

NCJH-IO (16) 

ISRL-IO (17) 

IFJ-ID(IB) 

10-10(26) 

IF  (PRMTd)  .EQ.0.0)  RETURN 
NC JMX-NC JM* 1 
NC JNX-NCJN* 1 


CALL  AXIAL  (Xl.BV.CV) 


SET  UP  RADIAL  SOURCE  LOCATIONS  IF  REQUIRED 
IF  (NSLOX.GT.O)  GO  TO  *0 
CALL  SLOC  (DFC.Xl.BV.CV.G.XOS.NSLO) 

IF  (ISRL.LE.O)  GO  TO  30 
IF  (CV.EO.O.O)  NSLO-ISRL 
IF  (CV.NE.0.0)  NSL0-ISRL-NSL0-24 
30  CONTINUE 
AO  CONTINUE 


FJPC- ( 1 ,-F JUT) • ( 1 .-FJUT) /F JTT 
ROI-O. 

XVS-OFC 
F JSW-0 

00  80  IVS-1.1000 
RO-XVS 

CALL  VELT  ( XVS.M. T JR.BV .CV.G. XMC.XTC . 3) 

IF  (IVS.EQ.l)  Hl-XMC(l) 

IF  (IVS.EO.I)  Tl-XTC(l) 

IF  (IO.EO.O)  GO  TO  50 

IF  (NUT.GT.O)  WRITE  (IW.460)  XVS, (XMC(I) .1-1.3) • (XTC(I) *1—1.3) 
50  CONTINUE 

IF  (XMC(l) .GE..99)  GO  TO  70 
TPRO-(l.-XMCd)  )-(l.-XMC(I)  )/XTC(l) 


590 

600 

610 

620 

630 

640 

650 

660 

670 

680 

690 

700 

710 

720 

730 

740 

750 

760 

770 

780 

790 

800 

810 

820 

830 

840 

850 

860 

870 

880 

890 

900 

9105 

920 

930 

940 

950 

9605 

970 

980 

990 

1000 

1010 

1020 

1030 

1040 

1050 

1060 

1070 

1080 

1090 

11005 

1110 

1120 

1130 

1140* 

1150 

1160 

1170 
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if  (FoSw.ne.o.or.ifj.eq.oj  go  to  60 

IF  (ABS(TPRO-FJPC) .LT.l.E-04)  ROI-XVS 
IF  (ABS(TPRO-FJPC)'.LT.1,E-04)  FJSW-1 
60  CONTINUE 

IF  (ABS(TPRO-l.) .LT..1E-03)  GO  TO  90 
TO  CONTINUE 

XVS«XVS*FJRT*0FC 
80  CONTINUE 
90  CONTINUE 

IF  (M.EQ.O.O.AND.TjR.EQ.l.)  RO-ROX 
IF  (XOS(l) .LT.DFC)  DFC-XOS ( 1 ) *PRMT (3> /2048. 

IF  (XOS(NSLO) .GT.PO)  RO«XOS(NSLO) -PRMT < 3 ) /2048. 
R0«0FC*IFIX(R0/PRMT(3) ) *PRMT (3) 

IF  (ROX.NE.O..AND.rOX.GT.XOS(NSLO> > ROI-ROX 
IF  (IFJ.EQ.O.AND.ROl.NE.O.)  RO-ROI 
IF  (IFJ.EQ.O.AND.RoI.EQ.O.)  ROI«RO 
IF  (IO.EO.O)  GO  TO  100 

IF  (NUT.GT.O)  WRITE  (IW.440)  Xl .DFC.ROI f RO.RC 
100  CONTINUE 


XKW2*KW*KW 

ICC*2 

00  120  MS-l.NSLO 

CALL  WELT  (XOS(MS) ,M, T JR, BV.CV.G. AMP, APLUG, ICC) 

prs(ms)»i.-amp(d*cang 

ID<41)»0 

IF  (ABS(PRS(MS) ) .LT.l.E-30)  IO(41)»ll 
IF  (ABS(PRS(MS)). LT.l.E-30)  GO  TO  420 
PRS(MS)»PRS(HS)*PRS(MS)/APLUG(1) 

PQ (MS) » (CANG*CANG-pRS (MS) ) *KW*KW 

PD(MS)«-APLUG(2)/APLUG(l)-2.*AMP(2)*CANG/(l,-iMP(l)«CANG) 

PA (MS) "-APLUG ( 2 ) /APLUG ( l ) 

IF  (ISG.EQ.l)  PA (MS) *0.0 
IF  (ISG.EQ.l)  PO(MS)»0. 

IF  (IO.EO.O)  GO  TO  UO 

IF  (NUT.GT.O)  WRITE  (IW.440)  XOS (MS) , AMP ( 1 ) , APLUG ( 1 ) *PRS (MS) .PQ (MS 
1) .PD(MS) 

110  CONTINUE 
120  CONTINUE 


ICC-3 

YCR»0. 

ICRIT-0 

CTEST«1.-M1*CANG 

IF  (CTEST.GT.0.0)  GO  TO  140 

ICRIT-1 

YCR»1. 

CALL  CRIT  (YCR»M,TjR.BV,CV.G,CAN6> 

ICC* JCC 

CALL  WELT  (YCR.M.TjR.BV.CV.G.XMC.XTC.ICC) 

ICC-3 

IF  ( IO.EO.O)  GO  TO  130 

IF  (NUT.GT.O)  WRITE  (IW.440)  YCR. (XMC(*I) .Kl-l.JCC) 
IF  (NUT.GT.O)  WRITE  (IW.440)  YCR. (XTC (KI ) »KI"1 . JCC) 
130  CONTINUE 
10 (41 ) >0 

IF  (YCR.LT. (DFC-PRMTI3) .RC) ) ID (41 ) »9 


1180 

1190 

1200 

1210 

1220 

1230 

1240 

1250 

1260 

1270 

1280 

1290 

1300 

1310 

1320 

1330 

1340 

1350* 

1360 

1370 

1380 

1390 

1400 

1410 

1420$ 

1430 

1440 

1450 

1460 

1470 

1480 

1490 

1500 

1510 

1520 

1530 

1540* 

1550 

1560 

1570 

1580 

1590 

1600 

1610 

1620 

1630 

1640 

1650 

1660 

1670$ 

1680 

1690$ 

1700 

1710 

1720* 

1730* 

1740 

1750 

1760 


IF  (VCR.LT, (DFC-PRmT(3) *RC) ) 60  TO  420 
CONTINUE 


KRO*CMPLX(KW*SANG.O.O) 
DUM«CTEST*CTEST/T1-CANG*CANG 
KRO-CHPLX (KW*KW*OUM»  0 . 0 ) 
KRO«CSQRT (KRO) 

IF  (DUM.LT.0.0)  KRd«-«RD 
IF  (NCJNX.GT.l)  GO  TO  160 
DO  150  NT5*1 • t 
DO  150  HS-l.NSLO 
TI J (NTS* MS) «0  • 

CONTINUE 

MXOS«l 


00  370  NCJX-NCJNXtNCJMX 

ICHECK»0 

NCJ-NCJX-1 

SCALE«10,**(-NCJ) 


BCWS«(0. 0,0.0) 

IF  (NGEO.EQ.l)  GO  TO  170 
RADM»-JSR*KPO 
BCNS«JSR*KRD 
BCWS" ( 0 . • 0 , ) 

ORIGIN  AT  EDGE  oF  SINGLE  SHEAR  LAYEH 
RPRES*-l./(2.*JSR*KRO) 

IERDSbO 
GO  TO  180 
CONTINUE 

CALL  RABC  (NC J.RO.qFC .KRO.KRD.RADM.BCNS.BCWS.RPRES* I EROS) 
CONTINUE 

DUM«T1/(CTEST*CTEST) 

BCNS*DUM*BCNS 
BCWS«OUM*BCWS 
IF  (IO.EO.O)  GO  TO  190 

IF  (NUT.GT.O)  WRITE  (IW.440)  KRO.KRD.BCWS.RADM.BCNS.RPRES 

CONTINUE 

ID (41 ) *0 

IF  (IEROS.NE.O)  ID (41 ) »1 0 
IF  (IEROS.NE.O)  GO  TO  420 


NOUT*0 

WRONSK  - REMOVEO 
PRMT (3)«-PRMT (3) 

PRMT ( 1 ) *DFC 
PRMT(2)*ROI 

IF  (ICRIT.EO.O)  GO  TO  200 

IF  (PRMTI2) ,GT, (YCR-RC) ) PRMT ( 2) *YCR-RC 

CONTINUE 

PRMT (6) "XOS (MXOS) -2,«PRMT (3) 

IF  (MXOS.EO.l)  PRMT (6) *OFC 
PRMT (8) -XOS (NSLO) *?,*PRMT (3) 

CALL  IDERY  (DERY. TEMP. NDIM, PRMT. ICC) 
Y(l) -SCALE 


11770 
11780 
11790 
11600 
11810 
11820 
11630 
11840 
11850 
11860 
11870 
11880 
11890 
11900 
11910 
11920 
11930 
11940 
11950 
11960 
11970 
11980 
11990 
12000 
12010 
12020 
12030 
12040 
12050 
12060 
12070 
12080 
12090 
121 00S 
12110 
12120 
12130 
12140 
12150 
12160* 
12170 
12180 
12190 
12200 
12210 
12220 
12230 
12240 
12250 
12260 
12270 
12280 
12290 
12300 
12310 
12320 
12330 
12340$ 
12350 
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Y(2)«0.  AI2360 

Y (3) "REAL (BCNS) • V < 1 1 AI2370 

Y (4) «0«  AI2380 

C EXTRA  MOO  NEEDED  HERE  IE  2.0  JET  CASE  TO  BE  INCLUOEO  AI2390 

IF  (NGEO.EG.O)  V(*>«AIMAG(BCNS>»V(1>  *12400 

C USE  NEXT  CARO  FOR  COMPLEX  ANGLES  AI2A10 

C Y(4)«AIMAG(BCNS)  AI2420 

CALL  HPCL  ( PRMT » Y » DER Y » NO I M » I HLF . AFCT ,FCT  » OUTP • AUX .At XCU)  AI2430S 

IF  (IHLF.GE.11)  STOP  2 *12440 

IF  (NOUT.GT.NMP)  STOP  3 AI2450 

IF  (ICRIT.EO.O)  GO  TO  240  AI2460 

AI2470 
A I 2480 

DO  210  IZ*1.NDIM  A I 2490 

210  Y (IZ) «Y ( IZ) ♦OERY (IZ)  • <PRHT (2) -XCU)  AI2500 

CALL  TRANS  (Y.ST2.N0IH)  AI2510S 

IF  (NOUT.GT.O)  NOUT-NOUT-l  AI2520 

PRMT ( 1 ) ».PI  AI2530 

PRMT(2)«0,  A I 2540 

PRMT(3)«PRMT(3>/(RC*2.«*IHX)  AI2550 

PRMT (3)»PRMT (3) «PI  AI2560 

00  220  IZ-l.NDIM  AI2570 

220  DERY ( IZ) "TEMP  AI2580 

ICCaJCC  A I 2590 

CALL  HPCL  (PRMT , Y.DERY.NOIM. IHLF .AFCT.FCT .OUTP, AUX.A.XCU)  AI2600S 

IF  (IHLF.GE.il)  STOP  2 AI2610 

IF  (NOUT.GT.NMP)  STOP  3 AI2620 

00  230  IZ-1.NOIM  AI2630 

230  Y(IZJ*Y(IZ)-DERY(I2)*XCU  AI2640 

CALL  TRANS  (Y.BE2.NDIM)  AI2650S 

A I 2660 
AI2670 

ICC-3  AI26S0 

PRMT (3) »RC»PRMT (3) aa.aaiHX  AI2690 

PRMT (3) aPRMT (3) /PI  AI2700 

IF  (NOUT.GT.O)  NOUT-NOUT-1  AI2710 

AI2720 
*12730 

PRMT ( 1 ) »YCR*RC  AI2740 

C WRONSK  AI2750 

PRMT (2) *R01  AI2760 

PRMT(6)»X0S(MX0S)-2.*PRMT(3)  AI2770 

IF  (PRMT ( 1 ) «GT .PRMT (211  PRMT (2) -PRMT < 1 > *PRM7 (3)  AI27fl0 

CALL  I OERY  (OERY, TEMP, NOIM, PRMT, ICC)  AI2790S 

CALL  HPCL  (PRMT, Y.oERY, NOIM, IHLF, AFCT.FCT. OUTP, AUX, A, XCU)  AI2800S 

IF  (IHLF.GE.11)  STOP  2 AI2810 

240  CONTINUE  AI2820 

NOUTM-NOUT  AI2630 

IF  (NOUTM.GT.NMP)  STOP  5 AI2840 

IF  ( IO.EQ.C)  GO  TO  250  AI2850 

IF  (NUT.GT.O)  WRITE  (IW.450)  NCJ.MXOS.NOUTP.NOUTM, ICHECK  A12860* 

250  CONTINUE  AI2870 

C AI2860 

C AI2890 

IF  (IFJ.EO.O)  GO  TO  260  AI2900 

PRMT ( 1 ) "XCU  A I 29 10 

PRMT (2) "RO  *12920 

PRMT(3)»PRMT(3)«IFIX(FJRT«FJFF)  AI2930 

PRMT (8) >0.  AI2940 


cio  o on  oo  o o o 


CALL  IOERY  (OERY. TEMP. NDIM, PRMT, ICC)  AI2950J 

CALL  HPcl  ( PRMT .Y.dERY.NDIM.IHLF.AFCT.FCT .OUTP.AUX.A.XCU)  AI2960S 

IF  (IHLF.GE.il)  STOP  2 AI2970 

PRMT(3)«PRMT(3)/IFIX<FJRT*FJFF)  AI2980 

260  CONTINUE  AI2990 

C A13000 

C A 1 30 1 0 

NOUT-O  AI3020 

PRMT (3) »-PRMT (3)  AI3030 

DO  290  MS-MXOS.NSLO  AI3040 

STEST-10.  AI3050 

DO  270  ISE-1.N0UTM  AI3060 

XTEST-ABS(YMI (ISE.l)-XOS(MS)  ) AI3070 

IF  (XTEST.GT.STEST)  GO  TO  280  AI3080 

STEST-XTEST  AI3090 

MMI-ISE  A 1 31 00 

270  CONTINUE  AI31I0 

280  CONTINUE  AI3120 

IF  (XOS(MS) .LT.YMI (MMl.l) ) MMI«MM!-1  AI3130 

STP2»CMPLX(YMI (MMI.2) • YMI (MMI,3) ) AI3140 

XINTP»(XOS(MS)-YMI (MMl.l) )/(YMl (MMl ♦ 1 . 1 ) -YMI (MMI.l) ) A 1 3150 

STP2»(1.-XINTP)*STP2*XINTP*CMPLX(YMI (MMl.l ,2) ,YMI (MMl.l .3) > A 1 3160 

ST2(MS)«STP2  A 131 70 

BE1 (MS)- (l.-XINTP;*SAV(MMI) .XINTP*SAV (MMl.l)  AI3180 

BET2-CMPLX (YMI (MM I ,4) .YMI (MM I .5) ) A I 3190 

BET20«CMPLX(YMI ( MM  j ♦ 1 , 4 ) .YMI (MMl.l, 5) ) AI3200 

8FT2»(1.-XINTP)*BET2.XINTP*BET20  AI3210 

0E2(MS)«BET2/ST2(Ms)  AI3220 

290  CONTINUE  AI3230 

A I 3240 
A 1 3250 

XN4-FLOAT (NCJ)  AI3260 

XN4«XN4*XN4*XN4*XN4  AI3270 

NCON-7* (MXOS-1 ) AI3280 

WRONSK  AI3290 

DO  300  IZ-1,4  AI3300 

Y(IZ)«Y(IZ) .DERY ( IZ) * (RO-XCU)  AI3310 

300  CONTINUE  AI3320 

CALL  WRCAL  (NGEO, Y , RAOM, RPRES.CAMP ( 1 ) ) A13330S 

CALCULATE  RADIAl/AZImuTHAL  COHERENCE  AND  RADIAL  A13340 

SOURCE  DISTRIBUTION  EFFECTS  FOR  THIS  AZIMUTHAL  MODE  AI3350 

IFLAG-0  AI3360 

IF  (10(25) .GT.0)  CALL  RAOCSD  ( IFLAG,NCJ»CAMP( 1 ) ,D, IO.NOUTM.BV.CV)  AI3370S 

AI3380 
AI3390 

DO  340  MS-MXOS.NSLO  AI3400 

XAV-XOS (MS)  A I 34 10 

EXTRA  MOD  NEEDED  HERE  IF  2-0  JET  CASE  TO  BE  INCLUDED  AI3420 

IF  (NGEO.EQ.O)  XAV-1.  AI 3430 

CAMP ( 2) -ST2 (MS) *CAmP ( 1 ) A 1 3440 

THIS  RESTRICTS  FREO.  TO  GT,  10,  E-l<*  AI3450 

IF(ALOG10(CABS(CAMP(2>) )-NCJ.LT.-30.)  CAMP (2) ■ ( 0, » 0. ) AI3460 

RC AMP- ABS (REAL (CAMP (2) ) ) AI3470 

AICAMP-ABS(AIMAG(CaMP(2) ) ) A 1 3480 

IF  (IO.EQ.O)  GO  TO  310  AI3490 

IF  (RCAMP.LT.1.E-30.AND.AICAMP.LT.1.E-30)  WRITE  (IW.440)  CAMP(2)  AI3500* 
31 f CONTINUE  A 1 35 10 

IF  (RCAMP.LT.1.E-30.AN0.AICAMP.LT.1.E-30)  CAMP (2) ■ ( 0 . » 0 . ) AI3520 

XAV2-XAV*XAV  AI3530 
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X*V3 -XAV-XAV2 

XAV4«XAV2*XAV2 

TRN-BE2 (MS) *PRS(MS) /X» V 


C EXTRA  MOO  NEEDED  HERE  IF  2-0  JET  CASE  TO  BE  INCLUDEO 

TRRN-PQ ( MS) *NCJ*NCJ/XAV2*TRN» (PD (MS) -NGEo/XAV) 

IF  (MTYPS.E0.1)  TRRN«PQ (MS) «NCJ*NCJ/XAV2»TRN* (PA (MS) -N6E0/XAV) 
IF  (MTYPS.EQ.3)  GO  TO  320 


EXTRA  INFO.  FOR  MTYPS.NE.3 

ICC-3 

CALL  VELT  ( XOS (MS) ,M , T JR.BV.CV.G. AMP. APLUG, ICC) 

AMP(D»1.-AMP(1)*CaNG 

ST  1 (MS)—CANG«AMP(2)/BE1  (MS) 

IF  (ISG.EO.l)  ST1 (MS)»(0. 0.0.0) 

IF  (ISG.EO.l)  AMP ( 2) >0 . 

AMP ( 3) =-CANG«AMP ( 3) /AMP ( 1 ) 

IF  (ISG.EO.l)  AMP ( 3) >0 . 

320  CONTINUE 


TRC-CABS(TRN) 

IF  (MTYPS.EO, 1 ) TRC«CABS(TRN*ST1 (MS) ) 

TRC«TRC*TRC 
TRRC-CABS ( TRRN) 

TRRC»TRRC*TRRC 
TRR-2,*REAL (TRN) 

TRFN- (TRN-1 ,/XAV) /XAV 

IF  (MTYPS.EO. 1)  TRFN«(TRN*ST1 (MS) -1 ,0/**V> /XAV 
TRFC«CABS(TRFN) 

TRFC«TRFC*TRFC 

TFFN«(TRN-NCJ*NCJ/XAV)/XAV 

TFFC-CABS(TFFN) 

tffc«tffc*tffc 

CN-CA0S (CAMP (2) ) 

CN»CN*CN 

IF  (NCJ.GT.O)  CN»2.»CN 
TX ( 1 ) «CN 
TX (2) »TRC*CN 
TX(3)*TRRC*CN 

EXTRA  MOO  NEFDED  HERE  IF  2-D  JET  CASE  TO  BE  INCLUDED 
IF  (NGEO.EO.O)  GO  TO  330 
TX (A) »NCJ*NCJ*CN/XAV2 

TX (5) »ncj*ncj*trfc#cn 

TX(6)«TFFC»CN 

TX  ( 7)  sCAHS  (TUM)  *C/'^S  ( TM\|)*CN 

330  CONTINUE 

CALL  TCON  (MS.NCJX.NCJNX.TIJ.TX.ECON.NCON.MXOS) 

IF  (NC0N.E0.7»NSL0)  GO  TO  380 
340  CONTINUE 


IF  ( IFIX (PRMT (7) ) .£0.0)  GO  TO  370 
IF  (IO.EO.O)  GO  TO  360 
DO  350  MS-ltNSLO 
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AI3540 

AI3550 

A I 3560 

AI3570 

AI3580 

AI3S90 

AI3600 

A 1 36 10 

A 1 3620 

AI3630 

A 1 3640 

AI3650S 

AI3660 

AI3670 

A I 3680 

AI3690 

AI3700 

AI3710 

AI3720 

AI3730 

AI3740 

AI3750 

AI3760 

AI3770 

AI3780 

AI3790 

A 1 3800 

A 1 38 10 

AI3820 

113830 

A I 3840 

A I 3850 

AI3860 

A 1 3870 

AI3880 

A I 3940 

A 1 3950 

AI3960 

AI3970 

AI3980 

AI3990 

AI4000 

A 1 40 10 

AI4020 

AI4030 


A 1 4040 

AI4050S 

AI4060 

AI4070 

AI4080 

AI4090 

AI4100 

AI4110 

AI4120 


WRITE  (IW.440)  (TIj(NTS,MS)  » NTS» 1 , 7)  AI4130* 

350  CONTINUE  AI4140 

360  CONTINUE  AI4150 

370  CONTINUE  AI4160 

C AI4170 

C AI41S0 

390  CONTINUE  AI4190 

TX(1)«0.0  A 14200 

SIPD-0.0  AI4210 

TISO*0 • 0 A 1 4220 

DO  410  MS«1 iNSLO  AI4230 

C SAVE  TX ( 1 ) .SIPO.TlSO  TOR  INTERPOLATION  IN  S.R.  LILLEY  AI4240 

0(41) »TX  ( 1 ) AI4250 

D(42)«SIP0  AI4260 

D(43)"TIS0  AI4270 

CALL  TSIGN  (MS.TIJ)  AI4290S 

TX(l)«10.*ALOG10(TiJ(l,MS) ) AI4290 

TX(2)«10.*ALOG10(TtJ(2,MS)/(.5«XKW2> ) AI4300 

TX(3)»10.*ALOG10(TiJ(3,MS)/(,375*XKW2»XK(K2) j AI4310 

C EXTRA  MOO  NEEDED  HERE  IE  2-D  JET  CASE  TO  BE  INCLUDED  AI4320 

IE  (NGEO.EQ.O)  GO  TO  390  AI4330 

TX(4>«10.*ALOG10(TlJ(4,MS)/(.5*XKW2) ) A 14340 

TX(5)»10.*ALOG10(TIJ(5,MS)/(.12S«XKW2*XK(K2, , AI4350 

TX(6)»10.*ALOG10(TiJ(6,MS)/(.375*XKW2*XKw2) ) AI4360 

TX ( 7) =10.0*ALOG) 0 (Tl J<  7, MS) / (n.5*XKW2) ) 

390  CONTINUE  AI4370 

TIS0«TIJ(3,MS)*TIJ(6,MS)*2,*TIJ(5,MS)  AI4380 

TIS0»TIS0*XKW2*XKW?*(CANG*«4)*TIJ(1.MS)*2.*XKW2«CANG»CANg»(TIJ(2,M  AI4390 
IS) *TI JI4.MS) ) A 1 4400 

TISO»10.*ALOG10(TIsO/(XKW2«XKW2) ) AI4410 

TlSO«TISO.TCOR  AI4420 

SIP0«TIJ(7,MS> • T I J (4  * MS) *XKW2*CANG*CAnG*TIJ(1,M5)  AI4430 

SIPD»10.*ALOG10 ( SIPD/XKW2)  AI4440 

SIPD»SIPD«DCOR  A I 4450 

ICC>1  A I 4460 

SMACH-1.  A I 4470 

IE  (M.NE.O.)  SMACH.M  AI44S0 

CALL  VELT  <XOS(MS) , SMACH, T JR.BV.CV.G. AMP, APLUG. ICC)  AI4490S 

C VEL.  AND  TEMP,  MUST  BE  LESS  THAN  10*  SOURCE  POS.  LESS  THAN  99.  AI4500 

IE  (IO.EQ.O)  GO  TO  400  AJ4510 

WRITE  ( IW.430)  XOS(MS) * AMP ( 1 ) » APLUG ( 1 ) » (TX(NTS) »NTS"1 * M , TISO.SIPD  AI4520* 
400  CONTINUE  AI4S30 

C JAN76  A 1 4540 

410  CONTINUE  AI45S0 

D (31 ) «TX ( 1 ) AI4560 

D(32)»SIPD  AI4570 

D ( 33 ) -T I SO  A 1 4590 

C AI4590 

C A I 4600 

C OBTAIN  N0N-C0MP4CT  ELOW  EACTORS  AI46I0 

IELAG-1  AI4620 

IE  (ID(25) ,GT.O)  CALL  RAOCSD  ( IELAG.NC JtCAMP < 1 ) ,D, ID.NOUTM.BV.CV)  AI4630S 
C A 14640 

C A 1 4650 

420  CONTINUE  A14660 

RETURN  AI4670 

C AI4680 

430  EORMAT  ( I X, E8.4, 2E7.4. 9E7.2)  A14690 

440  EORMAT  (1X.6E13.6)  AI4700 

450  EORMAT  (1X.3HNCJ.5I5)  AI4710 

460  EORM*T  (IX, 7E 11.4)  A14720 

END  AI4730- 
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•DECK  SLOC 

SUBROUTINE  SLOC  (XS*X1 tBV»CVtG»XOS*NSlO)  AK  10 

DIMENSION  XOS(l)  AK  20 

DIMENSION  U (40 ) AK  30 

DATA  U(l) »U(2) «U(3) , U(4) »U(5) ,U<6) »U(7) »U(8) ,U(9) «U(10> »U(11) « AK  AO 

1U(  12)  ,U(13).U<14>  »UM5)  ,U(16)  ,U<17>  ,U(18)  ,UU9)  »U (20)  iU(21) ,U<22)  , AK  50 

2 U(23) »U(24) /.99, ,98199, ,968865* .9481 t ,91859* .87741 • .82377,  AK  60 

3 .757455, .67936, .67. .66295, .6, ,59)905. .5, .408098, .3206435,  AK  70 

4 .2425485, .1762325,. 1225905, .081409. ,051541, ,0311374.. 0180080.  AK  80 

5 ,01/  AK  90 

IF  (CV.EQ.O.)  GO  TO  70  AK  100 

IF  (XI , G7.8. 01  > GO  TO  40  AK  HO 

RMOEL«i.*.022*Xl-.i2185*Xl  AK  120 

X0S(1)»2.*XS  AK  130 

ROEL* (RMDEL-XOS ( 1 ) ) /9.  AK  140 

DO  10  IOEL»l  .9  AK  150 

X0S(IDEL»1)«X0S(I0EU«RDEL  AK  160 

10  CONTINUE  AK  170 

ROEL».2437*X1/20.  AK  180 

00  20  I0Et«10,17  AK  190 

XOS(IOEl_*l)»XOS(IOEU *ROEL  AK  200 

20  CONTINUE  AK  210 

X0S(19)“l,«, 001007875* XI  AK  220 

XOS (20 ) *1 . AK  230 

XOS { 21 ) *1 , * . 00872375* XI  AK  240 

XOS ( 22) *XOS (18) *RDEL  AK  250 

00  30  IDEL-22.32  AK  260 

XOS(IDEL*1)*XOS(IOEU*ROEL  AK  270 

30  CONTINUE  AK  280 

NSL0»33  AK  290 

RETURN  AK  300 

40  CONTINUE  AK  310 

X0S(1)*2.0*XS  AK  320 

ROEL*0.2437*Xl/20.0  AK  330 

NMAX*(1.0*0.022*XUXOS(1) ) /ROEL  AK  340 

XOS ( NMAX»5) »1.0.0«022*X1  AK  350 

XOS (2) »XOS (NMAX.5) -NMAX*ROEL  AK  360 

NOUM>NMAX-l  AK  370 

00  50  I0UM-2.NDUM  AK  380 

X0S(IDUM»1)»X0S(IDUM)*R0EL  AK  390 

50  CONTINUE  AK  400 

XOS ( NMAX* 1 ) »1 . 0-0 , 00 1 007875*Xl  AK  410 

XOS ( NMAX.2) *1.0  AK  420 

XOS(NMAX*3>*1.0»0.00872375*X1  AK  430 

XOS (NMAX*4) »XOS (NMAX) *RDEL  AK  440 

N0MIN-NMAX»5  AK  450 

NOMAXaNMAX*14  AK  460 

00  60  IDUMaNDMlN, NOMAX  AK  470 

XOS(IDUM»l)aXOS(IDuM)»RDEL  AK  480 

60  CONTINUE  AK  490 

NSLOaNMAX* 15  AK  500 

RETURN  AK  510 

70  CONTINUE  AK  520 

NSL0«24  AK  530 

DO  80  lal.NSLO  AK  540 

XOS ( I > aBV*SORT ( ALOG ( 1 ,/U ( I ) ) ) AK  550 

IF  (XOS(l).LE.XS)  XOS ( I ) *1 , 1*XS  AK  560 

80  CONTINUE  AK  570 

RETURN  AK  580 

END  AK  590* 
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on  r»r»  no 


•occk  velt 


SUBROUTINE  VCLT  (X,M'TJR»6V*CV'6*XfcC»XTC( ICC) 

AL 

10 

DIMENSION  XMCUi 

AL 

20 

DIMENSION  XTCIl) 

AL 

30 

COMMON/  EJET/IRJ.EJUT.RJTT.RJRTfEJBV.RJCV 

AL 

40 

REAL  M 

AL 

50 

DATA  SRI/1 *7720538/ 

AL 

60 

VRT-0.0 

AL 

70 

OMM» (6-1 ») /2. 

AL 

60 

TJX-TJR-R JTT*6MM» (M-R JUT) • (M-R JUT) 

AL 

90 

r JTJX-R JTT- ( 1 .-6MM*R JUT*R JUT) 

AL 

100 

JR  (CV.EO.O.)  60  TO  180 

AL 

110 

AL 

120 

AL 

130 

XN«(ABS(X)-1.*CV)/BV 

AL 

140 

IR  IXN.6T.10.)  60  TO  10 

AL 

ISO 

IR  (XN.LT. -10.)  60  TO  70 

al 

160 

VR»0.5M1,-ERR(XN)> 

AL 

170 

XMC(1)»(M-RJUT)*VR 

AL 

160 

XTC(l)  -R JTT-6MM-XMC  ( 1 ) «XMC  ( 1 ) ♦ VR*T JX 

al 

190 

IR  (ICC.EQ.l.AND.IRJ.EO.O)  RETURN 

AL 

200 

IR  (IRJ.EO.O)  60  TO  90 

AL 

210 

60  TO  30 

AL 

220 

AL 

230 

AL 

240 

10 

00  20  1*1. ICC 

AL 

250 

XTC(I>»0. 

AL 

260 

20 

XMC ( I ) “0 .0 

al 

270 

XTC(1)*1. 

AL 

260 

IR  (IRJ.EO.O)  60  TO  60 

AL 

290 

AL 

300 

AL 

310 

30 

CONTINUE 

AL 

320 

XX- ( ABS ( X) /R JRT-1 . .R JCV) /R JBV 

AL 

330 

IR  (XX.6T.10.)  60  TO  60 

AL 

340 

IR  (XX.LT.-10.)  60  TO  50 

AL 

350 

VRT*0,5* (1 ,-ERR (XX) ) 

AL 

360 

XMC ( 1 ) -R JUT-VRT4XMC ( 1 > 

AL 

370 

IR  (XTC(l) .EQ.1,0)  XTC(1)»1,0-6MM«XMC(U*XMC(1)*VRT«RJTJX 

AL 

380 

*0 

CONTINUE 

AL 

390 

IR  (ICC.EO.l)  60  To  60 

al 

400 

IR  (XN.6T.10..ANO.CV.NE.0.)  60  TO  60 

AL 

410 

IR  (XN.6T. A. .AND. Cv.EO.O.)  60  TO  60 

AL 

420 

IR  (CV.EO.O.)  60  TO  210 

AL 

430 

60  TO  90 

AL 

4*0 

al 

450 

AL 

460 

50 

CONTINUE 

AL 

470 

XMC  1 1 ) «R JUT * XMC ( 1 ) 

AL 

460 

IR  (XTC(l).EO.l.O)  XTC(1)«RJTT 

AL 

490 

VRT-l, 

AL 

500 

60  TO  AO 

AL 

510 

00 

CONTINUE 

AL 

520 

RETURN 

al 

S30 

AL 

540 

AL 

550 

TO 

XMC  ( 1 ) «M 

AL 

560 

XTC(1)»TJR 

AL 

570 

IR  (ICC.EO.l)  RETURN 

AL 

580 

o o 


00  SO  i-2. ICC 
XTC(I)-0. 

SO  XMC  ( 1 ) -0 .0 

return 


90  CONTINUE 
XHC ( 1 ) -VR 
XMC(2>-1. 

IP  (ICC.6T.2)  XMC(3)-2.*XN 
N-ICC-1 

IF  (N-2)  120.120.100 
100  00  110  1-3. N 

110  XMC (1*1) -2.*XN-XMC (I)"2.-(I-2) -XMC (1-11 
120  EP-EXP(«XN*XN) 

FACT-EP/SPI 
DO  130  1-2. ICC 
FACT— FACT/BV 
130  XMC ( I ) -FACT-XMC ( 1 ) 

C FORM  OER.  OF  VEl.  PATIO 

00  150  NO-2. ICC 
XTC (NO) "0 , 

AFAC-1 ( 

00  140  NOR- 1. NO 
INDR-ND-NDR* 1 

XTC (NO) -XTC (ND) *AFaC-XMC ( I NOR) -XMC (NDR> 

AFAC-AFAC- (ND-NDR) /NOR 
140  CONTINUE 
150  CONTINUE 

DO  160  N0-2.ICC 

XTC  < NO) — GMM* (M-F JUT) • |M-F JUT) -XTC (NO) ♦ XMC (NO) -TJX 
160  CONTINUE 

DO  1 70  I-l.ICC 
XMC ( I ) ■ (M-F  JUT) -XMC ( I ) 
l TO  CONTINUE 

XMC ( 1 ) -F JUT-VRT.XMC ( 1 ) 

C FJ  GRADIENTS  NOT  INCLUDED 

RETURN 

c 

c 

160  CONTINUE 
XN-X/BV 

IF  (XN.GT.4.)  GO  TO  190 
VR-EXP(-XN-XN) 

XMC ( 1 ) ■ ( M«F  JUT ) • VR 

XTC ( 1 ) -F JTT-GMM-XMC  < 1 ) -XMC ( 1 ) ♦ VR-TJX 
IF  (ICC. EQ.l. AND. IFJ.EO.O)  RETURN 
IF  (IFJ.EO.O)  GO  To  210 
GO  TO  30 

c 

c 

190  DO  200  I-l.ICC 
XTC ( I ) -0* 

200  XMC ( I ) *0« 

xTcin-i. 

IF  (IFJ.EO.O)  RETURN 
GO  TO  30 

c 

c 
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AL  590 
AL  600 
AL  610 
AL  620 
AL  630 
AL  640 
AL  650 
AL  660 
AL  670 
AL  660 
AL  690 
AL  TOO 
AL  710 
AL  720 
AL  730 
AL  740 
AL  750 
AL  760 
AL  770 
AL  780 
AL  790 
AL  800 
AL  810 
AL  620 
AL  830 
AL  840 
AL  850 
AL  660 
AL  870 
AL  860 
AL  890 
AL  900 
AL  910 
AL  920 
AL  930 
AL  940 
AL  950 
AL  960 
AL  970 
AL  960 
AL  990 
AL1000 
AL1010 
AL1020 
AL1030 
AL1040 
AL1050 
All  060 
AL1070 
AL1060 
AL1090 
ALUOO 
AL1110 
AL1120 
ALII  30 
AL1140 
AL11S0 
AL1160 
AL1170 


210  CONTINUE 
XMC(1)»1. 

XMC (2) "2»*XN 
IF  ( ICC-2)  240.240,220 
220  00  230  Ia3, ICC 

230  AaC(I)«2.*XN*XMC(I-l)-2.»(I-2)»XMC(I-2) 

240  FACT-VR 

DO  250  I-l.ICC 
XMC ( I ) ■FACT*XMC ( I ) 

250  FACT«-FACT/BV 
DO  270  ND«2,ICC 
XTC(ND>«0. 

AFAC-1. 

00  260  NOR»l *ND 
INDR»ND-NOR*l 

XTC (NO) »XTC (NO) *AFAC«XMC ( INDR) *XMC (NOR) 

AFAC-AFAC* (NO-NDR) /NOR 
260  CONTINUE 
270  CONTINUE 

DO  2B0  N0*2, ICC 

XTC (NO) »-GMM* (M-FJuT) * (M-FJUT) *XTC (NO) *XMC (ND) *TJX 
280  CONTINUE 

DO  290  I>1,ICC 

XMC ( I ) ■ ( M»F  JUT ) •XMc ( I ) 

290  CONTINUE 

XMC ( 1 ) »F JUT*VRT.XMC ( 1 ) 

C FJ  GRADIENTS  NOT  INCLUDED 

RETURN 
ENO 


All  180 
AL1 190 
AL1200 
AL1210 
AL1220 
At  1230 
AL1240 
AL1250 
AL1260 
AL1270 
AL1280 
AL1290 
AL1300 
AL1310 
AL 1320 
AL1330 
AL1340 
AL1350 
AL1360 
AL1370 
AL 1 380 
AL1390 
AL1400 
AL1410 
AL1420 
AL1430 
AL 1440 
AL1450 
AL1460 


•OECK  ERF 

FUNCTION  ERF(XN) 

C ERROR  FUNCTION  RATIONAL  APPROXIMATION 

DATA  SPI,A1,A2, A3, A4/1. 7724538,. 278-Wa 
XA«ABS(XN) 

X 1 »XA 
X2«XA»X1 
X3»XA«X2 
X4»XA*X3 

XRFal ,»A1»X1 »A2*X?.A3«X3»A4*X4 
ERF«1 .-1 ./ (XRF*XRF*XRF  «XRF) 

IF  (XN.LT.O.)  ERF«-ERf 

RETURN 

END 


AM  10 

7,1.27  OF  NBS(ABRAMOHITZ)  AM  20 
, .230389, ,0009?2, .078108/  AM  30 

AM  40 
AM  SO 
AM  60 
AM  70 
AM  80 
AM  90 
AM  100 
AM  HO 
AM  120 

am  no- 
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•DECK 

CPI  T 

SUBROUTINE  CRIT  < Y , M, T JR.BV.CV t 6. CANG ) 

AN 

10 

DIMENSION  YMC  ( 3 \ 

AN 

20 

DIMENSION  YTC ( 3 ) 

AN 

30 

ICC»3 

AN 

AO 

DO  10  Nsl.10 

AN 

SO 

CALL  VEIT  (Y»M,TJR,BVtCV.G«YMC*YTC. ICC) 

AN 

60$ 

YX»Y» (1.-YMC(1)«CAnG)/<YMC<2)*CANG) 

AN 

70 

IE  (ABS( ( YX-Y)/YX) .LT. .001 ) GO  TO  20 

AN 

BO 

Y»YX 

AN 

90 

10 

CONTINUE 

AN 

100 

Y«0, 

AN 

no 

20 

RETURN 

AN 

120 

END 

AN 

130- 

•DECK  RABC 

SUBROUTINE  RABC  ( N , RO  * DEC • KRO . KRO • RADM  * BCNS • BC WS • RPRES • IEROS ) AO  10 


•DECK  RABC 

SUBROUTINE  RABC  {N(ROiDEC.KROtKRO«RADM»BCNS«BCWStRPRESt IERDS)  AO  10 

COMPLEX  CMPLX  AO  20 

COMPLEX  J.HNO.JnD  AO  30 

COMPLEX  KRO.KRD.RADM.BCNS.BCWS.RPRES  AO  40 

COMPLEX  ZtBJ.Y  AO  SO 

COMMON/ER/  IERX  AO  60 

COMMON/BUG/  IDBUG  AO  70 

1ERDS-0  AO  60 

J«(0.»1.)  AO  90 

Z»RO*KRO  AO  100 

p».ooi  ao  no 

call  CBESL1  (Z.N.Bj.D. IERDS)  AO  120S 

IE  HERDS. ME. 0)  RETURN  AO  130 

CALL  CBESL2  (Z.N.Y. IEROS)  AO  140$ 

IE  HERDS. NE.O)  RETURN  AO  150 

RPRES»BJ-J*Y  AO  160 

CALL  CBESL1  (Z.NH.BJ.D.IERDS)  AO  170$ 

IE  HERDS. NE.O)  RETURN  AO  180 

CALL  CBESL2  <ZtN*l,Y, IERDS)  AO  190$ 

IE  HERDS. NE.O)  RETURN  AO  200 

HND»-(BJ-J*Y> *N*RP9ES/Z  AO  210 

RADM«Z*HND/RPRES  AO  220 

Z»DEC*KRD  AO  230 

IE  (ELOAT(N*l) ,GT.250.*CABS(Z*Z) ) GO  TO  10  AO  240 

CALL  CBESL1  (ZtN.Bj.D* IERDS)  AO  2 SOS 

IE  HERDS. NE.O)  RETURN  AO  260 

BCNS-BJ  AO  270 

CALL  CBESL1  < Z.N* 1 ,BJtD , IERDS)  AO  280$ 

IE  HERDS, NE.O)  RETURN  AO  290 

JND»-B J»N*BCNS/Z  AO  300 

BCNS»Z* JND/BCNS  AO  310 

RETURN  AO  320 

10  BCNS«N-Z*Z/<2.*(N*1> ) AO  330 

RETURN  AO  340 

END  AO  350- 
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BESSEL  FUNCTION  OF  COMPLEX  VARIABLES 


SUBROUTINE  CBESL1  (CX.N.CBJ.D. IER) 

COMPLEX  CX*CALPHA,CBjtCFMl,CBPREV*CFM,CBMK,CS 
COMMON/BUG/  IOBUG 
IF  ( IOBUG, EO. 1 ) WRITE  (6(80) 

CBJ»(0.t0.) 

IF  (N.LT.O)  IER-I 
IF  (N.LT.O)  RETURN 
X»CA8S(CX) 

Y»AIMAG(CX) 

IF  (X.EO.O.O.ANO. Y.EO.O.O)  IER»2 
IF  (X.EO.O.O.ANO. Y.EO.O.O)  RETURN 
IF  (X.LE.15.)  NTEST«20.*10.*X-X**2/3. 

IF  (X.LE.15.)  GO  TO  10 
NTEST«90.*X/2. 

10  IF  (N.GE.NTEST)  IER«4 
IF  (N.GE.NTEST)  RETURN 
IER»0 
N1«N*1 

CBPREV" ( 0.  • 0.  ) 

IF  (X.LT.5.)  MA"X*6. 

IF  (X.LT.5.)  GO  TO  20 
MA«1,4*X*60,/X 
20  MB>N«X/4»2 

MZERO>MAXO (MA.MB) 

MMAX»NTEST 

IF  (M2ERO.GE.MMAX-2)  MMAX"MZEROO 
DO  70  M-MZERO.MMAX.3 
CFMl«(l,E-28.1.E-28) 

CFMa ( 0 . • 0 . ) 

CALPHAa (0. .0. ) 

IF  (M.EO. (M/2)*2)  jT«-l 
IF  (M.EQ. (M/2) *2)  GO  TO  30 
JT»1 

30  M2aM>2 

00  60  Kal,M2 
MKaM-K 

CBMK«2,*MK*CFM1/CX»CFM 

CFMaCFMl 

CFMlaCBMK 

IF  (MK-N-1)  50 .40 » 50 
40  CBJaCBMK 
50  JTa-JT 
CSa 1 ♦ JT 

60  CALPHAaCALPHA*CBMK*CS 
CBMK"2,*CFM1/CX-CFM 
IF  (N.EQ.O)  CBJaCBMK 
CALPHAaC ALPHA »CBMK 
CBJaCBJ/C ALPHA 
ACB JaCABS (CBJ) 

ERla (REAL (C8J) -REAL (CBPREV) ) /ACBJ 

ER2a ( AIMAG (CBJ) -AImAG (CBPREV) ) /ACBJ 

ER1  a (REAL (CBJ)  - REAL (CBPREV) ) / REAL ( CBJ) 

ER2  a (AIMAG(CBJ)  . AIMAG(CBPREV) ) / AIMAG(CBJ) 
IF  (ABS(ERl).GT.D)  GO  TO  TO 
IF  (ABS(ER2J .GT.D)  GO  TO  70 
RETURN 

70  CBPREV-CBJ 
IER«3 
RETURN 

80  FORMAT  (1X,4HCBE1) 

END 


* AP  10 

* AP  20 

* AP  30 

AP  40 
AP  50 
AP  60 
AP  70 
AP  80* 
AP  90 
AP  100 
AP  HO 
AP  120 
AP  130 
AP  140 
AP  150 
AP  160 
AP  170 
AP  180 
AP  190 
AP  200 
AP  210 
AP  220 
AP  230 
AP  240 
AP  250 
AP  260 
AP  270 
AP  280 
AP  290 
AP  300 
AP  310 
AP  320 
AP  330 
AP  340 
AP  350 
AP  360 
AP  370 
AP  380 
AP  390 
AP  400 
AP  410 
AP  420 
AP  430 
AP  440 
AP  450 
AP  460 
AP  470 
AP  480 
AP  490 
AP  500 
AP  510 
AP  520 
AP  530 
AP  540 
AP  550 
AP  560 
AP  570 
AP  580 
AP  590 
AP  600 
AP  610 
AP  620 
AP  630 
AP  640 
AP  650 
AP  660- 
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•OECK  CBESL2 


CBESl? 


SUBROUTINE  CBESL2  (X.N.BY, IER) 

C COMPLEX  CSQRT.CsIN.CCOS.CLOG 

COMPLEX  T,  PO*  QO.  PI.  01.  A.  8.  YO,  Yl.  XX.  X2.  TERM. 
1 TS.  YA.  YB.  YC 
COMPLEX  X,  BY 

COMMON/BUG/  IOBuG 
ir  (IDBUG.EQ.l)  WRITE  (6.200) 

IF  (N)  180,10.10 
10  IER«0 

IF  ( CABS ( X) ) 190,190.20 
20  PI*3. 141592653 

IF  (CABS (X) -4, ) 40,40,30 
30  T«4,/X 

IF  (IOBUG. EO.l)  WRITE  (6,200) 

PO*. 3989422793 
QO*-. 0124669441 
PI*. 3989422819 
01*. 0374008364 
A*T*T 
B>A 

P0*P0-. 0017530620*4 
Q0»O0*. 0004564324*4 
P1«P1*.0029218256*A 
Qi*Ql-. 00063904*4 
A*A*A 

P 0*P0*.00017343*A 
Q0«Q0«. 0000869791*4 
PI *P1«. 000 22320 3* A 
Q1*Q1*. 0001064 741*A 
A*A*B 

P0»P0-. 0000487613*4 
OO-OO*. 0000342468*4 
P1»P1*. 0000580759*4 
01«01-. 0000398708*4 

A«A*B 

P0»P0*. 0000173565*4 
00*00-. 0000142078*4 
P1*P1-.000020092*A 
01*01*. 00001622*4 
A*A*8 

P0*P0-. 00000 37043* A 
00*00*. 0000032312*4 
P1*P1*. 0000042414*4 
01 *01 -.00 00 036594* A 
A*S0RTI2.*PI) 

B*4.*A 
P0«A*P0 
00«B*00/X 
P1*A*P1 
01 *8*01 /X 
A*X-PI /4 . 

B*CSORT(2./(PI*X) ) 

Y0»B* (P0*CSIN(A) *Qo*CCOS(A» ) 

Yl*B*(-Pl*CCOS(A) *q!*CSIN(A) ) 


AO 

10 

AQ 

20 

AQ 

30 

AO 

40 

AO 

50 

AO 

60 

AO 

70 

AO 

80 

AO 

90 

AO 

100 

AQ 

no* 

AO 

120 

AQ 

130 

AO 

140 

AO 

150 

AO 

160 

AO 

170 

AO 

180* 

AO 

190 

AO 

200 

AO 

210 

AO 

220 

AO 

230 

AO 

240 

AQ 

250 

AQ 

260 

AO 

270 

AO 

2B0 

AO 

290 

AO 

300 

AQ 

310 

AQ 

320 

AO 

330 

AQ 

340 

AQ 

350 

AO 

360 

AQ 

370 

AQ 

380 

AO 

390 

AO 

400 

AO 

410 

AO 

420 

AQ 

430 

AO 

440 

AQ 

450 

AO 

460 

AQ 

470 

AQ 

480 

AO 

490 

AO 

500 

AQ 

510 

AO 

520 

AQ 

530 

AO 

540 

AO 

550 

AO 

560 

AO 

570 

AO 

580 
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IF  (IDBUG.EQ.l)  WRITE  (6*200) 

AO  590- 

GO  TO  90 

AC  600 

*0 

XX-X/2. 

AO  610 

X2-XX-XX 

AO  620 

T«CUOG(XX) *.57721566*9 

AO  630 

SUM-0, 

AO  6*0 

TERM-T 

AO  650 

YO-T 

AO  660 

00  70  L-1.15 

AO  670 

IF  (L-l)  50*60*50 

AO  680 

so 

SUM-SUM*1 ./FLOAT (L-l ) 

AO  690 

60 

FL-L 

AO  700 

TS-T-SUM 

AO  710 

TERM- (TERM- (-X2) /FL**2> - ( 1 .-1 ./ (FL*TS) ) 

AO  720 

70 

yo-yo*term 

AO  730 

TERM-XX-(T-.S) 

AQ  7*0 

SUM-0. 

AO  750 

Yl-TERM 

AO  760 

00  60  L-2.16 

AO  770 

SUM-SUM* 1 , /FLOAT ( L- 1 ) 

AO  780 

FL-L 

AO  790 

FL1-FL-1, 

AO  eoo 

TS-T-SUM 

AQ  810 

TERM- (TERM- (-X2) / (FL1*FL) ) * ( (TS-.5/FL) / ( YS* ,5/FLl > ) 

AO  820 

ao 

Y1-Y1*TERM 

AQ  830 

PK’2,/P  I 

AO  8*0 

Y0-PI2-Y0 

AO  850 

Yl— PI2/X*PI2-Y1 

AO  860 

90 

IF  (N-l)  100*100*130 

AO  870 

100 

IF  (N)  110*120*110 

AO  880 

no 

BY-Y1 

AO  890 

GO  TO  170 

AO  900 

120 

BY-YO 

AO  910 

GO  TO  170 

AO  920 

130 

ya-yo 

AO  930 

yb-yi 

AO  9*0 

K-l 

AO  950 

i*o 

T-FLOAT (2-K) /X 

AO  960 

YC-T-YB-YA 

AQ  970 

K-K*l 

AO  980 

IF  (K-N)  150*160*150 

AQ  990 

150 

ya-yb 

AOIOOO 

yb-yc 

AQ1010 

GO  TO  140 

A01020 

160 

bv-yc 

A01030 

170 

RETURN 

AOl 0*0 

110 

IER-i 

AQ1050 

RETURN 

AQ1060 

190 

IER-2 

AQ1070 

RETURN 

AOl 080 

C 

AOIOOO 

200 

FORMAT  ( 1 X* AHCBE2) 

AOl 100 

ENO 

A01110- 

90 


' 
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•DECK  IDERY 


SUBROUTINE  IDERY  (DERY«TEMPtNOIM«PRMT • ICC) 

AR 

10 

DIMENSION  DERY ( | ) #PRMT ( 1 ) 

AR 

20 

DO  10  1*1 »NDIM 

AR 

30 

OERY ( I ) *TEMP 

AR 

40 

10  CONTINUE 

AR 

50 

ICC-3 

AR 

60 

IF  ( IFI X ( PRMT (?) ) , £Q, 0 ) ICC*1 

AR 

70 

RETURN 

AR 

80 

END 

AR 

90 

nn  o o o o o no  on  non  non 


•DECK  HPCL 

SUBROUTINE  HPCL  (PRMT* Y.DERY.NDIM. IHLF »AFCT»FCT .OUTP.AUX.A.X)  A 10 

DIMENSION  PRMT ( 1 ) « Y ( 1 ) *0ERY ( 1 1 » AUX ( 16* 1).A(1).BT(6)  A 20 

GO  TO  AO  A 30 

A AO 

THIS  PART  OF  SUBROUTINE  HPCL  COMPUTES  THE  RIGHT  HAND  SIDE  OERY  OF  A 50 
THE  GIVEN  SYSTEM  OF  LINEAR  DIFFERENTIAL  EQUATIONS.  A 60 

10  CALL  AFCT  (X. A.y)  A 70S 

call  FCT  (X.DERY)  a bos 

DO  30  M-l.NDIM  A 90 

LL-M-NOIM  A 100 

hs-0.  a no 

DO  20  Lal .NDIM  A 120 

LL*LL*NDIM  A 130 

20  HS«HS*A(LL)»Y<L)  * 1A0 

30  DERY (M) «HS»DERY (M)  A ISO 

GO  TO  ( 90 .420. 440. 460 • 190*260 .290 .560 .900 • 750 • 770. 320) * ISW2  A 160 

A 170 

POSSIBLE  BREAK-POINT  FOR  LINKAGE  A 180 

A 190 

AO  N»]  A 200 

IJ>1  A 210 

IHLF«0  A 220 

X»PRMT(1)  A 230 

H«PRMT(3>  A 2A0 

PRMT(5>«0,  A 250 

DO  50  1*1 .NDIM  A 260 

AUX ( 16. I ) *0.  A 270 

AUX (15.1) «DERY ( I ) A 280 

50  AUX ( 1 . I ) «Y ( I ) A 290 

IF  (H* (PRMT (2) -X) ) 70.60*80  A 300 

A 310 

ERROR  RETURNS  A 320 

60  IHLF>12  A 330 

GO  TO  80  A 340 

70  IHLF«13  A 350 

A 360 

COMPUTATION  OF  OERy  FOR  STARTING  VALUES  A 370 

80  ISW2-1  A 380 

GO  TO  10  A 390 

A 400 

RECOROING  OF  STARTING  VALUES  A 410 

90  CALL  OUTP  (X. Y. OERY. IHLF.NOIM, PRMT)  A 420S 

IF  (PRMT (5) ) llO.ldO.llO  A 430 

100  IF  ( IHLF)  120.120.110  A 440 

110  RETURN  A 450 

120  DO  130  I ■ 1 . NO I M A 460 

130  AUX (8.1 ) "DERY ( I ) A 470 

A 480 

COMPUTATION  OF  AUX (2.1)  A 490 

ISM1*1  * 500 

GO  TO  400  A 510 

A 520 

140  X>X«H  A 530 

00  150  1*1 .NDIM  A 540 

150  AUX(2.I)>Y(I)  A 550 

A 560 

INCREMENT  H IS  TESTED  by  MEANS  OF  BISECTION  A 570 

160  IHLF«IHLF*I  A 580 
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uu 


X»X«M 

oo  i7o  :«i,ndim 
170  AUX  (4*1)  *»AUX  (2*1) 

H».5»N 

N»1 

ISW1-2 
60  TO  400 

c 

180  X«X*H 
ISW2-5 
60  TO  10 
190  N«2 

00  200  I ■ 1 • NO I M 
AUX (2* I ) *Y ( I ) 

200  AUX(9* I ) "DERY ( I ) 

ISW1-3 
60  TO  400 
C 

C COMPUTATION  OP  TEST  VALUE  DELT 

210  0EL7>0. 

00  220  I-l.NOIM 

C 118  0ELT«0ELT*AUX(l5tI)*ABS(Y(I)-AUX(4*I) ) 

IF  (Y(I).EO.O.O)  60  TO  220 

DELT«DELT*AUX (15.1) «ABS < < Y C I > -AUX (4. 1) ) /Y ( I ) ) 

220  CONTINUE 

DEL  T> . 06666667*O£L T 
If  <ABS<0ELT)-PRMT(4) ) 250 t 250 *230 
230  IE  (IHLF-10)  160*240*240 
C 

C NO  SATISFACTORY  ACCURACY  AFTER  10  BISECTIONS.  ERROR  MESSAGE. 

240  IHLF-11 
X*X*M 
00  TO  80 

SATISFACTORY  ACCURACY  AFTER  LESS  THAN  11  BISECTIONS 
250  X>X«H 
ISW2>6 
60  TO  10 

260  DO  270  I ■ 1 * NO I M 
AUX (3* I ) "Y ( I ) 

270  AUX (10*1) "OERY ( I ) 

N«3 
ISN1-4 
GO  TO  400 

280  N«1 
X»X*M 
ISW2«7 
GO  TO  10 
290  X“PRMT ( 1 ) 

DO  300  I«l*NOIM 
AUX (11,1) »OERY ( I ) 

300  Y(I)»AUX(1,I)*H*(.375»AuX(8,I)*.7916667*AUX<9,I)-.2083333*AUX(10,I 
1 ) **04166667*OERY ( I) ) 

310  X*X*H 
N»N*1 
ISW2>12 
60  TO  10 

320  CALL  OUTP  <X,Y,OERy.IHLF,NDIM,PRMT) 


880 
690 
900 
910 
920 
930 
940 
950 
960 
970 
980 
990 
1000 
1010 
1020 
1030 
1040 
1050 
1060 
1070 
1080 
1090 
1100 
1110 
1120 
1130 
1140 
1150 
1160 
1 170S 
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IF  ( PRMT ( 5 ) ) 110.330,110  *1180 

330  IF  (N-M  3*0. 480. 400  *1190 

340  00  350  1*1 »NDIM  *1200 

AUX (N» I ) *Y ( I ) A1210 

350  *UX(N,7,I)«DEPV<I)  A1220 

IF  (N-3)  360.380.480  *1230 

C *1240 

360  DO  370  I *1 , NO IM  *1250 

0ELT*AUX (9,1) **UX(9,I)  *1260 

DELT»OELT*DELT  *1270 

370  V ( I ) **UX (1,1) ♦ .3333333*H* (*UX (8,1) *DELT*AUX ( 10 • I ) ) *1280 

GO  TO  310  *1290 

C *1300 

380  DO  390  I*l,NOIH  *1310 

OELT*AUX(9,I)*AUX(10,I)  *1320 

DELT«OELT*DELT*OELT  A1330 

390  r(I)*AUX(l,I>..375*H*(AuX(8,I)«OELT*AU*(ll,I) ) *1340 

GO  TO  310  *1350 

A1360 

THE  FOLLOWING  PART  OF  SUBROUTINE  HPCL  COMPUTES  BY  MEANS  OF  *1370 

RUNGE-KUTT*  METHOD  STARTING  VALUES  FOR  ThE  NOT  SELF-STARTING  *1380 

PREDICTOR-CORRECTOR  METHOD,  ' *1390 

400  Z*X  *1400 

DO  410  1*1 »NOIM  *1410 

XX*H»AUX(N*7,I)  *1420 

AUX (5.1) *XX  *1430 

*10  Y(I)*AUX(N,I)*,4*XX  *1440 

XX  IS  AN  AUXILIARY  STORAGE  LOCATION  *1450 

*1460 

X*Z*.4*H  *1470 

ISW2*2  *1480 

GO  TO  10  *1490 

420  00  430  1*1 ,NDIM  *1500 

XX«H*OERY(l)  *1510 

AUX (6,1) *XX  *1520 

430  Y(I)*AUX(N,D*  ,2969776*  AUX  <5, 1>*» 15875^6*  XX  *1530 

*1540 

X*Z*.4557372*H  *1550 

ISW2-3  *1560 

GO  TO  10  *1570 

440  DO  450  I * 1 , NO I M *1500 

XX»H*DERY ( I ) *1590 

AUX (7 , 1 > *XX  *1600 

*50  Y<n*AUX(N,I>*,2ieiQ0**AUX<5,I)-3.050965*AuX<6»I)*3.832865*XX  *1610 

*1620 

X*Z*H  *1630 

ISW2>4  *1640 

GO  TO  10  *1650 

460  DO  470  I * 1 , ND I M *1660 

*70  Y(I)*AUX(N,l)«.1747603*AUX(5,I)-.551*B07*AuX(6,n»1.205S36*AUX(7,I  *1670 

1 ) • , 1 7 1 1 8*8*H*0ERY ( I ) *1680 

X*Z  *1690 

GO  TO  (140,180,210,280),  ISW1  *1700 

*1710 

POSSIBLE  BREAK-POINT  FOR  LINKAGE  *1720 

*1730 

STARTING  VALUES  ARE  COMPUTED,  *1740 

NOW  START  HAMMINGS  MODIFIED  PREDICTOR-CORRECTOR  METHOD*  *1750 

460  ISTEP-3  *1760 
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*90  IF  (N-8)  520.500.520 
C 

C N-8  CAUSES  THE  ROMS  OF  AUX  TO  CHANGE  THEIR  STORAGE  LOCATIONS 
500  00  510  N*2,7 
00  510  I ■ 1 . NO I M 
AUXIN-1, I)*AUX|N, I) 

510  AUXIN*6,I)*AUXIN*7,I> 

N*7 

N LESS  THAN  8 CAUSES  N*l  TO  GET  N 
520  N»N*l 

COMPUTATION  OF  NEXT  VECTOR  Y 
00  530  1 ■ 1 . NO I M 
AUXIN-1. I)*YII) 

530  AUX IN*6, I ) *DERY ( I ) 

X*X*H 

540  ISTEP*ISTEP*1 
00  550  I-l.NOIM 

DELT-AUX (N-4. I ) ♦ 1 ,333333*H*  < AUX (N.6. I ) *AuX |N*6» I > -AUX (N«5, 1 ) *AUX (N 
1*4,I)*AUX(N*4,I) ) 

Y ( I ) "CELT- ,9256 198* AUX 1 16. I ) 

550  AUX (16.1) bOELT 

PREDICTOR  IS  NOW  GENERATED  IN  ROW  16  OF  AUX,  MODIFIED  PREDICTOR 
IS  GENERATED  IN  Y.  DELT  MEANS  AN  AUXILIARY  STORAGE. 

ISW2-8 
GO  TO  10 

DERIVATIVE  OF  MODIFIED  PREOICTOR  IS  GENERATED  IN  DERY 
560  DO  570  1*1 *NOIM 

DELT*.125*(9.*AuX(N-l.I)-AUX(N-3,n*3.*M*<0ERYII)*AUX|N«6,I)*AUX(N 

l*6.n-AUX(N*5,I))  > 

AUX ( 16. I ) -AUX (16,1) -DELT 
570  YII) "CELT-, 074380 17* AUX 1 16. I ) 

TEST  WHETHER  H MUST  8E  HALVED  OR  DOUBLED 
DELT-0. 

DO  580  1*1 »NDIM 
IF  I Y 1 1 ) .EQ.0.0)  GO  TO  580 
310  DELT«DELT*AUX|15,I)«ABS(AUXI16,I) ) 
DELT*DELT*AUXI15.I)*A8S(AUXI16,I)/YII) ) 

580  CONTINUE 

IF  (ABS (DELT) -PRMT (4) ) 590,720,720 

H MUST  NOT  BE  HALVED.  THAT  MEANS  YII)  ARE  GOOO, 

590  ISW2*9 
GO  TO  10 

600  CALL  OUTP  IX.Y.DERy.IHLF.NDIM.PRMT) 

IF  (PRMT (5) ) 620, 610,620 
610  IF  (IHLF-11)  630,620,620 
620  RETURN 

630  IF  (H* (X-PRMT (2) ) ) 640,620,620 
640  IF  ( ABS (X-PRMT (2) )-,l*ABS(H) ) 620,650,650 
650  IF  |ABS(DELT)-.02*PRMT(4) ) 660,660,490 

M COULO  BE  DOUBLED  IF  ALL  NECESSARY  PRtCEEDING  VALUES  ARE 
AVAILABLE 
660  IF  (IHLF)  490,490,670 


1 7 TO 

1780 

1790 

1800 

1810 

1820 

1830 

1840 

1850 

1860 

1870 

1880 

1890 

1900 

1910 

1920 

1930 

1940 

1950 

1960 

1970 

1980 

1990 

2000 

2010 

2020 

2030 

2040 

2050 

2060 

2070 

2080 

2090 

2100 

2110 

2120 

2130 

2140 

2150 

2160 

2170 

2180 

2190 

2200 

2210 

2220 

2230 

2240$ 

2250 

2260 

2270 

2280 

2290 

2300 

2310 

2320 

2330 

2340 

2350 
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670  IF  (N-7)  490*680*680  A2360 


670  IF  (N-7)  490*680*680  A2360 

680  IF  (ISTEP-4)  490*690*690  A2370 

690  IMOD-ISTEP/2  A2380 

IF  ( I STEP- 1 MOO- 1 MOO ) 690*700*490  A2390 

700  H>H«H  A2400 

IHLF-IHLF-1  *2410 

ISTEP-0  A2420 

00  710  1*1 *NDIM  *2430 

AUX ( N- 1 * I ) -AUX (N-2 , I ) *2440 

AUX ( N-2 • I ) -AUX (N-4 , I ) A2450 

AUX <N-3, I) -AUXIN-6, I)  A2460 

AUX(N*6*I)-AUX(N*5,I)  A2470 

AUX(N*5,I)-AUX<N*3,I)  A2480 

AUX(N*4,I)-AUX(N*1,I)  A2490 

DELT-AUX ( N * 6 . 1 ) *AUX (N*5, 1 ) *2500 

DELT-DELT ♦DELT*0ELT  A2510 

710  AUX(16*I)>8.962963*(Y(I)*AUX(N-3*I) ) >3*361 lll*H«(OERY(I) »DELT»AUX(  *2520 
1N*4* I ) ) A 2530 

GO  TO  490  A2540 

A 2550 
A2560 

H MUST  BE  HALVED  A2570 

720  IHLF»IHLF*1  A2580 

IF  (IHLF-10)  730,730,590  A2590 

730  H-.5-H  *2600 

ISTEP-0  *2610 

DO  740  I-l.NDIM  *2620 

Y ( I ) -,00390625* (80 .*AUX (N-l , I ) *135.**U* (N-2* I ) «40«**UX  <N>3* I ) *AUX ( A2630 

IN-4,1) )-.1171875*<AUX(N»6,I)-6.*AUX<N*S,I>-AUX(N*4,I>  >•«  *2640 

AUX IN-4, I) -.00390625* < 12,**UX <N-1 , I ) *l35.**UX (N-2, I ) *10&.*AUX (N-3,  A2650 

II) ♦ AUX (N-4* I ) )«, 0234375- ( AUX (N*6* I )*18**AUX(N*5*I) -9***UX (N*4* I ) ) • *2660 

2H  *2670 

AUX (N-3* I ) -AUX (N-2, I ) *2680 

740  AUX(N*4,I)-AUX<N*5,I)  *2690 

OEL-X-H  *2700 

X-OEL»  <H*H)  A2710 

ISW2-10  *2720 

GO  TO  10  *2730 

750  00  760  I-i*NDIM  *2740 

AUX (N>2, I ) -Y  ( I ) *2750 

AUX (N*5» I ) -DERY ( I ) *2760 

760  Y ( I ) -AUX (N>4, I ) *2770 

X-X- (H*H)  *2780 

ISW2-1 1 *2790 

GO  TO  10  *2800 

770  X-DEL  *2810 

00  780  I-l.NDIM  *2820 

0ELT-*UX(M»5*I)«*UX(N«4,I)  *2830 

OELT-OELT*DELT*DELT  *2840 

AUX 116*1) -8,962963- (AUX (N>1 , I ) >Y ( I ) >>3*36111 1-H- (AUX (N*6, I ) *OELT*D  *2850 
lERY(D)  *2860 

780  AUX (N*3* I ) -DERY ( I ) *2870 

GO  TO  540  *2880 

END  *2890- 


•DECK  AFCT 

SUBROUTINE  AFCT  (X,A,Y) 
DIMENSION  A < 1 ) ,Y(l» 

COMPLEX  acf,bcf,ccf,dcf 
DO  10  Is!  • 16 
10  A(I)-0.0 

CALL  COEF  <X,ACF,BCF,CCF,OCF> 
A(3)«REAL<ACF) 

AI3)«-A(3) 

A(8)«A(3> 

A (9 ) “REAL ( BCF ) 

A(l*)aA(9) 

A ( 1 0 ) »A IMAG ( BCF ) 

A ( 1 3) »“A (10) 

A ( 7 ) ■ A I MAG ( ACF ) 

A ( A)  »-A  ( 7 ) 

RETURN 

END 
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•DECK  OUTP 

SUBROUTINE  OUTP  (X.Y.DERY.IHLE.NDIM.PRMT)  0 10 

OIMENSION  Y(1).DERY(1),PRMT(1)  D 20 

COMMON  YPU (450. 5)  D 30 

COMPLEX  ZDUM.SAyE.SAvEM  D 40 

COMPLEX  SAV  D SO 

COMMON/CR1T/  ICc.RC.XMC<16) .XTC(16) »YCR  D 60 

COMMON/SE/  SAVE  D 70 

COMMON/STYPE/  MTYPS  0 80 

COMMON/C I / IR, I W.NOUT • I CHECK  D 90 

COMMON/BJ/  M.KW.CANG.PI.BV.CV.TJR.G  D 100 

COMMON/JB/  Ml,MlD«M100tTR»TRD«TR0D  D 110 

COMMON/BN/  NGEO.NCJ.NUT  0 120 

COMMON  /SRDCSD/  SaV(4S0)  0 130 

REAL  M.KW.Ml.MlD.MlDD  D 140 

XDUM-X  D 150 

IE  (ICC.GT.3)  XDUM.YCR«RC*COS(X)  0 160 

IE  (XDUM,LT.PRMT(6) ,OR.XDUM,GT.PRMT{8) > GO  TO  20  D 170 

NOUT*NOUT*l  D 180 

If  (NOUT.GT.450)  WRITE  (IW.50)  X D 190* 

IE  (N0UT.GT.450)  RETURN  D 200 

IE  (ICC.GT.3)  GO  To  30  D 210 

YPU ( NOUT, 1)*X  0 220 

DO  10  1*1 .NDIM  D 230 

10  YPU(NOUT,I*1)*Y(I)*(1.0-M1*CANG)**(MTyPS-3)  D 240 

SAV(NOUT) »SAVE  0 250 

20  CONTINUE  D 260 

IE  (IEIX(PRMT(7) ) .EO.O)  RETURN  D 270 

IE  (NOUT.GT.450)  WRITE  (6.40)  X D 280* 

WRITE  (IW.50)  X,Y(i) »Y(3) .Ml.MID.TR.TRDtIMLE  D 290* 

RETURN  0 300 

30  CONTINUE  D 310 

SAVEM*SAVE**(3-MTYPS)  0 320 

YPU ( NOUT . 1 ) *XDUM  0 330 

ZDUM*CMPLX(Y(1) ,Y(?) I/SAVEM  0340 

YPU(NOUT.2)*REAL(ZoUM)  D 350 

YPU ( NOUT » 3 ) *A I MAG ( ZDUM ) D 360 

ZDUM*CMPLX (Y(3) . Y (4) ) /SAVEM  D 370 

YPU (NOUT .4) *REAL (ZDUM)  D 380 

YPU (NOUT .5) *A IMAG ( 20Um)  0 390 

SAV (NOUT) -SAVE  D 400 

GO  TO  20  D 410 

C D 420 

40  EORMAT  (IX, "STORAGE  OVERELOW  - TRY  LARGER  STEP  SIZE,  X * «,E13,6)  D 430 

50  EORMAT  (1X.7E11.4.M)  D 440 

END  D 450- 


I 


•DECK  COEF 

SUBROUTINE  COEF  (X,*CF,BCF.CCF,OCF) 

C CHECK  FOR  2-0  CaSE 

REAL  M,KW,M1,M1D,M1D0 
COMMON/C  I / IR* lu.NOUT • I CHECK 
COMMON/BJ/  M.KW.CANG.PI.BV.CV.TJR.G 
COMMON/JB/  Ml ,MiD,Hioo,TRtTRO.TROO 
C0MM0N/CRIT/ICC.RC.XMC(16> .XTC(16) ,TCR 
COMMON/BN/  NGEO.NCJ.NUT 
COMMON/SF/  SAVF 
COMPLEX  SAVF 
COMPLEX  CMPLXtCEXP 

COMPLEX  ACF,BCF,CCF,OCF,Z£RO.FAC.J.WUN,MPHI,CXJJ 

COMPLEX  MPHIX 

COMPLEX  TPHI.TPHlX.CSIG 

DIMENSION  YMC (3) 

DIMENSION  YTC ( 3) 

ZERO* (0. 0*0.0) 

J*<0. 0.1.0) 

W UN* (l.o, 0.0) 

IF  (ICC.GT.3)  GO  To  20 

CALL  VELT  (X.M.TJR.BV.CV.G.YMC.YTC.ICC) 

M1*YMC(1) 

TR*YTC(1) 

IF  (ICC.EQ.l)  GO  To  10 
IF  (X.LT.O.)  YMC ( 2 ) ■- YMC (2) 

JF  (X.LT.O.)  YTC (2) *-YTC (2) 

MID* YMC  ( 2 ) 

TRD*YTC (2) 

M1DD*YMC(3) 

TROD*YTC (3) 

10  CONTINUE 

V»1.0-M1*CANG 

SAVF»CMPLX(V,0.0) 

P*V*V/TR 

ACF-CMPLX  <KW*KW* (P-CANG*CANG) /P.0,0) 

IF  (NGEO.GT.O)  ACF,X*ACF-NCJ*NCJ/ (X*P) 

BCF*CMPLX (P, 0.0) 

IF  (NGEO.GT.O)  BCF.BCF/x 
CCF-ZERO 
DCF-ZERO 
RETURN 
20  CONTINUE 
MPHI*ZERO 
TPHI-ZERO 
MPHIX-ZERO 
TPHIX-ZERO 
CSIG*RC*CEXP ( J*X) 

CXJJ-WUN 

FAC-WUN 

00  AO  JJ-l.ICC 
MPHI*MPHI*XMC(JJ)*FAC/CXJJ 
TPHI*TPHI *XTC ( JJ) *F*C/CX JJ 

IF  (CABS( (MPHI-MPHIX) /MPHI ) .GT..0001)  00  TO  30 
IF  (CABS ( ( TPHI-TPH j X) /TPHI ) .LT.,0001)  00  TO  50 
30  CONTINUE 
MPHIXaMPHI 
TPHIX*TPHI 
FAC*FAC*CSIG 


E 10 
E 20 
E 30 
E AO 
E 50 
E 60 
E 70 
E BO 
E 90 
E 100 
E 110 
E 120 
E 130 
E 1 AO 
E 150 
E 160 
E 170 
E 160 
E 190 
E 200 
E 21  OS 
E 220 
E 230 
E 2A0 
E 250 
E 260 
E 270 
E 260 
E 290 
E 300 
E 310 
E 320 
E 330 
E 3A0 
E 350 
E 360 
E 370 
E 380 
E 390 
E A00 
E A10 
E A20 
E A30 
E AAO 
E A50 
E A60 
E A70 
E A80 
E A90 
E 500 
E 510 
E 520 
E 530 
E SAO 
E 550 
E 560 
E 570 
E 580 


100 


XJJBJJ 

CXJJ»CMPIX<XJJ.0.0)*CXJJ 
40  CONTINUE 
STOP  7 
50  CONTINUE 

F AC* WUN-MPH I *C ANG 
SAVF-FAC 

FAC«FAC«FAC/TPHI 

ACF«J*CSIG*KW*KW*(wUN-CANG*CANG/FAC) 

IF  (NGEO.EQ.l)  ACF»(YCR*CSIG)«ACF.NCJ«NCJ/(FAC*<YCR*CSIG) )*J*CSIG 
BCF»J*CSIG*FAC 

IF  (NGEO.EQ.l)  BCFbBCF/(YCR*CSIG) 

CCF-ZERO 
DCF* ZERO 

I F (JJ.EQ.ICC)  ICHECK-1 

WRITE ( I Wt 400)  HPHI.TPHI.ACF.JJ, ICC 
400  FORMAT ( IX, 6E 13. 6/ IX, 215) 

MlsREAL(MPHI) 

TR-REAL(TPHI) 

M1D*XMC<2) 

TRO*XTC (2) 

MIOO«XHC(3) 

TRDD*XTC<3) 

RETURN 

END 


E 590 
E 600 
E 610 
E 620 
E 630 
E 640 
E 650 
E 660 
E 670 
E 6B0 
E 690 
E 700 
E 710 
E 720 
E 730 
E 740 
E 750 
E 760 
E 770 
E 7B0 
E 790 
E 800 
E 810 
E 820 
E 830- 


( 


•DECK  TRANS 

SUBROUTINE  TRANS  (ST2.Y,ND:.45  f 10 

OIMENSION  ST2(l).y(l)  f 20 

00  10  I«1,N0IM  f 30 

V ( I ) "ST2 ( I ) f AO 

10  CONTINUE  f 50 

RETURN  f 60 

ENO  f TO- 


•DECK  WRCAL 

SUBROUTINE  WRCAL  <NGEO,Y.RADM,RPRES»FW«OnS) 

COMPLEX  cmplx 

COMPLEX  RADM,RPrES*FWRONS  .wronsk 
DIMENSION  Ytn 
PI-3.1M593 
WRONSK* ( l,, 0.) 

IF  (NGEO.EO.l)  WRONSK»CMPLX(0,.-2,/PI) 

FWRONS»<CMFLX(Y(\) ,Y<2) )»RA0M-CMPLX(Y(3) ,Y<A) ) )*RPREi 

FWRONS*WROHSK/FwROnS 

RETURN 

ENO 


•DECK  TCON 

SUBROUTINE  TCON  <MS.NCJX,NC JNX.TI J.TX.ECON.NCON.MXOS)  H 10 

DIMENSION  TIJ(7,D «TX(1)  H 20 

IF  (NCJX.EO.NCJNX)  60  TO  20  H 30 

IF  <NCJX.LT. 3)  60  TO  20  H *0 

ICT-0  H 50 

DO  10  1-1*7  H 60 

IF  (TIJ(I.MS) .EO.O.)  GO  TO  10  H TO 

IF  <TX<I)/TIJ(I,MS).LT.EC0N)  NCON-NCON*!  H 80 

IF  (TX(I)/TIJ(I.MS) .LT.ECON/1 00. ) ICT«lCT*l  H 90 

10  CONTINUE  H 100 

IF  <ICT.EO.n  MXOS«MXOS*l  H no 

20  00  30  1-1.7  H 120 

TIJ<I.MS)«TIJ<I,MS)*T*<n  H 130 

30  CONTINUE  M 160 

RETURN  H 150 

END  H 160- 


•DECK  TSIGM 

SUBROUTINE  TSIGN  (MS,TIj> 

DIMENSION  TIJ(6,1) 

COMMON/C I / IR« IwtNOUT • I CHECK 
DO  20  I ■ 1 1 6 

IE  ITIJII.MSI .GT.O.)  GO  TO  10 
WRITE  1IW.30)  I.Tlj(I.MS) 
TIJ(I*MS)«“TIJ(I»M«;) 

IE  (TIJ(I.MS) .EO.O.)  TIj(l,MS)«l. 

10  CONTINUE 
20  CONTINUE 
RETURN 
C 

30  E0RM4T  (1X,13H**S0uRCE  TYPE,I5.2HIS,E13,6) 
ENO 


I 10 
I 20 
I 30 
I 40 
I SO 
I 60* 
I TO 
I 80 
I 90 
I 100 
I 110 
I 120 
I 130 
I 140- 


•OCCK  R ADC SO 

SUBROUTINE  RAOCSD  < IFLAG.NCJ.MNV.D. IO*NOUTM,BV,CV) 
DIMENSION  0(1) ,10(1) •XM(2) .XT (2) .SLTB(S) .A (5. 7) ,TIJ<7.5) 
DIMENSION  SSIM(S) .SSID (5) .SSI0(5) 

COMPLEX  C (450. 7) 

COMPLEX  WINV.TRRN.RES 

complex  sav 
real  m.kw 

COMMON  YPU (4S0 .5) 

COMMON  /SRDCSO/  SaV(4S0) 

COMMON/PSD/  RC.BLTB.CVO 

c 

RPI*1. 772424 

CVD*CV 

6*0 (8) 

RSM*D(9) 

RSC-O(IO) 

KW«0 ( 1 1 > 

XKW2*KW*KW 
M*D (12) 

TJR»0 (13) 

CANG*D (14) 

X1»0 ( 16) 

TC0R«0(18) 

DCOR*D ( 19) 

C 

IW*ID(2) 

NGE0*I0(3> 

MTYPS*I0(4> 

I MB* ID (8) 

NCL*IO (25) 

10*10(26) 

C 60  AND  rORM  SIO.SID  IF  THIS  IS  FINAL  CALL 

IF  (IFLAG.GT.O)  GO  TO  70 
DO  10  IT*1 ,NCL 

C 5LTB ( IT) *0 ( IT«24) *X1 

SLTB ( IT) *D ( I T*25) 

10  CONTINUE 

ANINV*CABS (WINV) 

RC*RSC*X1*1.0 

P99*BV*S0RT ( ALOG 1 1 . 0/0 . 99 ) ) 

IF  (CV.EO.O.O.AND.RC.LT.R99)  RC-999 
IF  (RC.LE.2.0*D(4) > RC*2, 0*0(41 
BLTB*0.5*X1*RSM/0. 83255461 1 
IF  (8LTB.LE.0.0)  return 
RC0«RC/BL7B 

REF*BLT8*BLTB/2.0*(EXP(-RCB*RCB) *RCB*RPI* ( 1 , 0*ERF (RCB) ) ) 
ICC*1 

CALL  VELT  (RC.M.TJR.BV.CV.G.XM.XT.ICC) 

XKAPS2* ( l , O-XM ( 1 ) *cANG) « ( 1 , 0«XM ( l ) *CANG> /XT ( 1 ) -CANG*CANG 
XKAPS2*ABS(XKAPS2) 

IF  (NCJ.NE.O)  GO  To  30 
00  20  I T*1 .5 
DO  20  JS* 1.7 
20  TIJ(JS.IT)*0.0 
30  CONTINUE 

C SET  UP  CNAB  FOR  ALL  SOURCE  TYPES 

ICC*2 

DO  40  1*1 .NOUTM 


J 10 
J 20 
J 30 
J 40 
J 50 
J 60 
J 70 
J 80 
J 90 
J 100 
J no 
J 120 
J 130 
J 140 
J 150 
J 160 
J 170 
J 180 
J 190 
J 200 
J 210 
J 220 
J 230 
J 240 
J 250 
J 260 
J 270 
J 280 
J 290 
J 300 
J 310 
J 320 
J 330 
J 340 
J 350 
J 360 
J 370 
J 380 
J 390 
J 400 
J 410 
J 420 
J 430 
J 440 
J 450 
J 460 
J 470 
J 480S 
J 490 
J 500 
J 510 
J 520 
J 530 
J 540 
J 550 
J 560 
J 570 
J 580 


106 


R-YPU( 1 1 ! ) J 590 

CALL  VELT  (R,M,T JR.BV.CV.G. XM.XT , ICC)  J 6005 

PRS»1.0-XM(l)*CANG  j 610 

PRS-PRS*PRS/XT(1)  j 620 

PQ-(CANG-CANG-PRS)*KW*KW  J 630 

PD--XT ( 2 ) /XT ( 1 ) «2. 0#XH (2) -CANG/ ( 1 , 0«XM ( 1 J -CANG)  J 640 

C(1,1)-CMPLX(YPU(I,2)»YPU(I»3)>  J 650 

C(I,2)»CMPlX(YPU(I,4),YPU(I,5>)  J 660 

C(I,2)-C(I,2)*PRS/R  J 670 

TRRN-(PQ*NCJ*NCJ/(R*R> >*C(I,1) ♦ (PD-NGEO/R) -C ( I ,2)  J 680 

C(I.3)"TRRN-(MTvPS-3)»XH<2)*CANG/(1.0-XM(i )-CANG)-C(I»2>  J 690 

C(I.4)-NCj-C(I,l)/9  J 700 

C{I,6)«(C(I,2)-NCJ-NCJ-C<I.1)/R)/P  J 710 

C(I,7)«C(I,2> 

C(1.2)«C(I,2)-XM(2,*CANG*C(I.1)/SAV(I)  J 720 

C ( I ,5) -NC J-  <C(I,2)-C(I,1)/R)/R  J 730 

40  CONTINUE  J 740 

00  60  ITal »NCL  J 750 

IF  (SLTB(IT)  .LT.OCil  .OR.BLTB.LT.Odn  GO  TO  60  J 760 

00  50  JS-1,7  J 770 

CALL  INTRAP  <NC J. VpU ( 1 . 1 ) .C ( 1 , JS) ,NOUTM, SLTB ( I T) ,RES. IERS)  J 7805 

IF  (CABS(RES).LE.O.O)  RES-(l.E-99,0.0>  J 790 

C(IT.JS)-RES  J 800 

C(IT.JS)-C(IT,JS)*AWINV»AWINV  J 810 

ARG-KW-SLTB(IT)/2.o  J 820 

IF  (SLTB(IT) .LT.BLTB/10.0)  ARG-0.0  J 830 

C(1T,JS)-EXP(ARG*APG*XKAPS2)-C<IT,JS)  J 840 

C«IT,jS)»C(IT,JS)/(REF«SLTB(IT)»SLTB(lT)/2,0)  J 850 

TIJ(JS,IT)-TIJ(JS«lT)*CABS(C(IT«JS))  J 860 

IF  (NCJ.NE.O)  TIJ(JS,IT)-TIJ(JS,IT)*CABS(C(IT,JS))  J 870 

50  CONTINUE  J 880 

SIM-10. 0-ALOG10(CABS(C(IT,1)))  J 890 

IF  (NCJ.EO.O)  SSIM(IT)»SIM  J 900 

SIM-SIM-SSIMUT)  J 910 

SID-CABSIC ( IT, 7) ) .CABS (C  ( IT, 4)) *XKW2*CANG*CANG*CABS (C ( IT, 1 ) ) J 920 

SID-10. 0»ALOG10(SIo/XKW2)  J 930 

IF  (NCJ.EO.O)  SS1D (IT) -SIO  J 940 

SIO-SIO-SSIO(IT)  J 950 

SIO-CABS (C ( I T , 3 ) ) .CABS (C ( IT,6) ) »2.0*CABS(C ( X T , 5 ) ) J 960 

SI0-SI0*XKW2*XKW2»c^NG**4*CABS(C(IT,l) ) ♦2.0-CANG—2-XKW2*  (CABS  (C ( I J 970 

1T,2) ) .CABS (C ( IT,4) j ) J 980 

S10-I0.0-ALOG10(SIQ/(XKW2*XKW2) ) J 990 

IF  (NCJ.EO.O)  SSIQ( IT) -SIO  J1000 

SIO-SIO-SSIO(IT)  J1010 

IF  (IO.EO.O)  GO  TO  60  J1020 

IF  (IWB.NE.O)  WRITE  (IW.100)  IERS.SLTB ( IT) , (TIJ( JS,IT) .JS-1.7) ,SIM  J1030* 
l.SID.SlO.NCJ  J1040 

60  CONTINUE  J1050 

GO  TO  90  J1060 

70  CONTINUE  J1070 

00  80  IT-1, NCL  Jl 080 

IF  (SLTB(lT).LT.D(l). OR.BLTB.LT. 0(D)  GO  TO  80  J1090 

A(IT,1)-10,0-ALOG10(TIJ(1,IT) ) Jl 1 00 

A(IT,2)-10.0*ALOGlo(TIJ(2,IT)/(0.5*XKw2))  JIUO 

A(IT,3)-10.0-ALOG1o(T1J(3,IT)/(0.375*X«W2#xKW2) ) J1120 

A ( IT,4) -lO.O-ALOGl o (Tl J(4, IT) / (0.5-XKW2) ) J1130 

A(IT,5)-10.0-ALOGlo(TlJ(5,IT)/(0.125*XKW2-XKW2) ) J1140 

A(IT,6)-10.0*ALOG1o(TIJ(6,IT)/(0.375*XKW2-xkW2))  Jl 150 

A ( IT, 7)  »10.0*AL0r.m  (TI  J(7,IT)  /(O.S-XK-2)  ) 

SIO-TIJ(3,IT)*TIJ(6,IT)*2.0*TIJ(5,IT)  JU60 

SI0-SI0.XKW2-XKW2* (CANG—4) *TI J ( 1 , IT) •2.0-CANG-CANG-XKW2* (TI J(2, IT  J1170 
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fc*-  


l)*TIJ(4.IT>)  JU#0 

SIO»10.0*A10610  <SI0/(XKW2*XKW2)  ) JU90 

SIO>SIQ*TCOR  J1200 

SI0»TIJ(7,IT)*TIJU.IT)*XKW2*CANG<»CANG#TIJ(I.IT)  J1210 

S!D«10.0«»LOG10(SID/XKW2)  J1220 

SIO-SID.OCOR  J1230 

IF  (IO.EG.O)  60  TO  80  J12*0 

IF  (IWB.NE.O)  WRITE  (IW.UO)  SLTB < IT) , ( A < IT, JS) , JS«1 . 7) .SIO.SID  J1250* 

80  CONTINUE  J1260 

0(36>-A(IT.l)  J12T0 

0 (37) >SIO  J1280 

D (38) "SIO  J1290 

90  CONTINUE  J1300 

RETURN  J1310 

J1320 

100  FORMAT  (IX.  lit  11*11.4.15)  J1330 

110  FORMAT  (lX,Fi.4,l<.x.9l-'7.2)  J1340 

END  J1350- 


I 

f 


* 


•DECK  INTRAP 

SUBROUTINE  INTRAP  (NCJ.R.CNAB,N0UTMtSLT8,RES. IERS) 
COMMON/PSD/  RC.BLTB.CVD 
DIMENSION  R ( 1 ) 

COMPLEX  CNAB(l) ,YIN(450) ,YOUT(450) .RES 
IERS-0 

RMIN»RC-1.96*BLTB*1.414 
RMAX»RC*1 ,96*BLTB*i  ,4U 
SLTB2»SLTB»SLTB/2,o 
IZC-0 

IP  (SLTB.LT.BLTB/lo.O)  IZC»1 
00  AO  JOUT-1, NOUTM 
RP I X»R ( JOUT) 

YOUT(JOUT)«(0. 0,0.0) 

IP  (RPIX.LT.RMIN.OR.RPIX.GT.RMAX)  GO  TO  40 
RPB«RP I X/SLTB 
IP  (IZC.EQ.O)  GO  TO  10 

YIN (NOUTM) -CNAB ( JOUD  »SRPSD (RE I X) »SLTB2 
GO  TO  30 
10  CONTINUE 

DO  20  JIN«1 tNOUTM 
YlN(JIN)-(0. 0,0.0) 

RVAR-R ( JIN) 

IP  (RVAR,LT.RMlN,OR.RVAR„GT.RMAX)  GO  TO  20 

RVB-RVAR/SLTB 

ARG«2.0*RPB*RVB 

DR2- (RVB-RFB) • (RVB-RFB) 

C «675, 84.X, 741, 67  POR  EXP(X)  ON  COC  7600 

IP  (DR2.GT ,3,84)  GO  TO  20 
CALL  BESI  <ARG.NCJ,ANS,IER) 

IP  (IER.NE.O)  IERS«1 

YIN( JIN)»RVAR*CNAB(JIN)*SRPSD(RVAR)*ANS*EXP(-DR2) 

20  CONTINUE 

CALL  OTFG  <R»YIN,Y/N, NOUTM) 

30  CONTINUE 

YOUT (JOUT) «RF I X*CONJG (CNAB (JOUT) ) *SRPSU ( RP I X) *YIN (NOUTM) 
40  CONTINUE 

CALL  OTFG  (R.YOUT.yOuT, NOUTM) 

RES-YOUT (NOUTM) 

RETURN 

ENO 


•DECK  SRPSO 

FUNCTION  SRPSD  < R > 
COMMON/PSO/  RC.BLTB.CVO 
SRPSO-O.O 
OR* ( R«RC ) /BLTB 
DR2*0P*DR 

IP  (0R2.GT.7B.0)  Go  TO  10 
SRPS0«EXP ( -DR2/2 . 0 ) 

10  CONTINUE 
RETURN 
END 


L 

L 

L 

L 

L 

L 

L 

L 

L 


10 

20 

30 

40 

SO 

60 

TO 

80 

90 


L 100- 


•DECK 


BESI 

SUBROUTINE  BESI  (X.N.BI.IER) 

BESI  MODIFIED  T0  COMPUTE  EXP (-X) -ORIGINAL 
IER-0 
81-1,0 

IF  (N)  210.20.10 
IF  (X)  220. AO. 40 
IF  (X)  220,30.40 
RETURN 
T0L-1.0E-2 

IF  (X-12.0)  60.60,50 
IF  ( X-FLOAT (N) ) 60,60,170 
XX-X/2.0 
TERM* 1.0 

IF  (N)  100.100.70 
00  90  I - 1 » N 
FI-I 

IF  (ABS(TERM)-1.0E-68)  80,90.90 

IER-3 

BI-0.0 

RETURN 

TERM-TERM«XX/FI 

81-TERM 

xx-xx*xx 

DO  120  K-1,1000 

IF  <ABS(TERM)  - ABS(BI*TOL>)  100,100.80 
IF  (ABS(TERM)-ABS(BI»TOL) ) 130,130.110 
80  FK-K»(N-K) 

FK-FLOAT (K) -FLOAT <N-K> 

TERM-TERM* (XX/FK) 

BI-BI-TERM 
IER-5 
60  TO  160 
CONTINUE 

IF  (X-170.0)  150.150,140 

IER-4 

GO  TO  160 

BI-EXP (-X) «BI 

RETURN 

FN-6»N-N 

IF  (X-170.0)  115,111,111 

111  IER-4 

RETURN 

XX-1.0/«B.0*X) 

TERM- 1.0 
BI-1.0 

00  190  K-1,30 

IF  (ABS(TERM)-ABS(TOL#Bl) ) 200,200,180 
r«-(2»K-l)*»2 

TERM-TERM»x**(FK-FN) /FLOAT (K) 

BI-BI-TERM 
GO  TO  60 
PIO. 141592653 
8I-BI»EXP(X)/SQRT<2.0*PI»X) 

BI-BI/SORT (2»0*PI*X) 

GO  TO  160 
IER-1 
GO  TO  160 
IER-2 

GO  TO  160 
ENO 


M 10 
M 20 
M 30 
M 40 
M so 
M 60 
M 70 
M 80 
M 90 
M 100 
M no 
M 120 
M 130 
M 140 
M ISO 
M 160 
M 170 
M 180 
M 190 
M 200 
M 210 
M 220 
M 230 
M 240 
M 250 
M 260 
M 270 
M 280 
M 290 
M 300 
M 310 
M 320 
M 330 
M 340 
M 350 
M 360 
M 370 
M 380 
M 390 
M 400 
M 410 
M 420 
M 430 
M 440 
M 450 
M 460 
M 470 
M 480 
M 490 
M 500 
M 510 
M 520 
M 530 
M 540 
M 550 
M 560 
M 570 
M 580 
M 590 
M 600- 
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•OECK  OTFG 

SUBROUTINE  OTFG 


PURPOSE 

TO  COMPUTE  THE  VECTOR  OF  INTEGRAL  VALUES  FOR  A given 
general  table  of  argument  ano  function  values. 

DESCRIPTION  IS  ON  PAGE  86  OF  IBM-SSP  MANUAL 


10 

20 

30 


N 40 
N SO 
N 60 
N 70 


N 

N 


BO 

90 


N 100 


0<JU<J<J0<J0<J00U0<J00<J 


•deck  blktmn 

BLOCK  DATA  TMN 

INPUT  DATA«*««* 

A-ETA(SM) 

B»SPLNO(SM) 

C«CQ(SM) 

D«SPLNO (SM) 

E«E(SM) 
r»co(SM) 

M«ARGUMENT  X IN  EXPONENTIAL  DECAY  FACTOR 
P-EXPONENTIAL  DECAy  FACTOR  DEC(X)  FOR  ARGUMENT  X 

R»RATIO  OF  CENTER-LINE  VELOCITY  TO  JET  EXIT  VELOCITY  AT  EACH 
STROUHAL  NUMBER 

U«RATIO  OF  MEAN  VELOCITY  TO  CENTER-LINE  VELOCITY  AT  EACH 
STANDARD  SOURCE  POSITION 

COMMON/FOUR/A (16) 

COMMON/FI VE/B ( 16) 

COMMON/SIX/C (16) 

COMMON/SEVEN/O (16) 

COMMON/EIGHT/E (16) 

COMMON/ANINE/F ( 16) 

COMMON/ELEVEN/H (7) 

COMMON/ TWELVE/P (7) 

C 

C0MM0N/F0UR1/  A1(28> 

COMMON  /FIVE1/  B 1 (28) 

COMMON  /SIX1/  Cl <?8) 

COMMON  /SEVEN1/  Dl (28) 

COMMON  /EIGHT1/  El (28) 

COMMON  /ANINE1/  Fl (28) 

COMMON  /EIGHTY1/  SDl (28,6) .SDT1 (28,6) 

C 

COMMON/ TH I RTN1/  Rl (28) 

COMMON/THI RTN/R (16) 

C0MM0N/F0URTN/U(24> 

C 

COMMON/E  I GHTY/T1 (6) ,SD(16,6) 

C 

DATA  < T 1 (I)  . I«1 ,4)  / 0.980,  1,770,  2.209,  3,330  / 

DATA  ( (SO(N,K) ,N«1,16» »K«l»4)  / 0 .67 , 0.8o ,0 .95, 1 . 18 , * , 3,1.70, 

1 2. 00, 2. 30, 2. 62, 2. 92, 3. 23, 3. 50, 3, 75, 4, 00, 4. 25, A. <,S,0.6j, 0.80, 

2 0.95, 1.18, 1.43, 1.70, 2. 00, 2. 30, 2. 70, 3. 10, 3. 40, 3. 80, 4. 1$, 4 

3 4.80, 5.15, 0.67, 0.80, 0.95 ,1.15, 1.50, 1.90,2.30, 2, 72,3,14, 3,:.: 

4 3.95,4.38,4.75,5.12,5.40,5.60,0.67,0.80,0.95,1.20,1,55,2.00, 

5 2.50,2.90,3.45,3.90,4,35,4,75,5.10,5.35,5,60,5.80  / 

C 

DATA  ( (S0T1 (N.I) ,N»1*2B> ,I»1,4)  / 

10. 01. 0. 01. 0.01. 0.01 .0.01. 0.01. 0.05. 0.13. 0.30. 0.52. 0.80. 1.05. 1.30, 
21.50,1.75,1.90,2.05,2.18,2.30,2.40,2.50,2.60,2.69,2.79,2.89,2.96, 
33.03,3.09, 

40. 08. 0. 09. 0.1 1.0. 12. 0.15.0. 23. 0.32. 0.45. 0.65. 0.90. 1.20* 1.50, 1.80, 
52.10,2.35,2.55,2.70,2.90,3.03,3.17,3.30,3.43,3.55,3.67,3.79,3.89, 
63«98 06« 

70,20t0»22«0.25t0'28»0*3l»0'3990,53f0'70«0«95vl'25«l,60»l,95f2,25' 
82. 55, 2. 85, 3. 05. 3. 30, 3. So, 3. 70, 3. 90,4. 06, 4. 23,4. 39, 4. 56*4, 71, 4. 84, 


0 10 
0 20 
0 30 
0 40 
0 50 
0 60 
0 70 
0 80 
0 90 
0 100 
0 110 
0 120 
0 130 
0 140 
0 150 
0 160 
0 170 
0 180 
0 190 
0 200 
0 210 
0 220 
0 230 
0 240 
0 250 
0 260 
0 270 
0 280 
0 290 
0 300 
0 310 
0 320 
0 330 
0 340 
0 350 
0 360 
0 370 
0 380 
0 390 
0 400 
0 410 
0 420 
0 430 
0 440 
0 450 
0 460 
0 470 
0 480 
0 490 
0 500 
0 510 
0 520 
0 530 
0 540 
0 550 
0 560 
0 570 
0 580 


▼ 


113 


9*. 94,5. 04,  0 590 

50. 25. 0. 28. 0.32. 0.36. 0.45. 0.57. 0.75. 0.95. 1.25. 1.60. 2. 00.2.35. 2. 70.  0 600 

53. 00 . 3. 30 .3. 60 .3. 85 .4.10. 4. 30 ,*.50,4.70 <4, 80 *5, 10,5.24, 5. 42, 5, 56,  0 610 

S5. 68,5. 80/  0 620 

0  630 

0*7*  ( (SOI ( N » I ) ,NS1,2B) , I ■ 1 , 4 ) / 0 640 

1 0.11,0.14,0.18,0.23,0.31,0.45,0.65,0.85,1,10,1.35,1.60,1,85,2.20,  0 650 

2 2. 55, 3. 00, 3. 30, 3. 60, 3. 85, 4. 10, 4. 45, 4, 75, 5. 10, 5. 32, 5. 53,5. 71, 5. 86,  0 660 

3 5.99,6.11,  0 670 

4 0.11, 0.14, 0.18, 0.23, 0.31, 0.45, 0.65, 0,85, 1.10,1. 35,1. 60, 1.85, 2. 25,  0 680 

5 2. 70, 3. 15,3. 50, 3. 95,4. 30,4. 70, 5. 00, 5. 30, 5.58, 5. 82, 6, 04, 6. 24,6. 41,  0 690 

6 6.55,6.68,  0 700 

7 0. 11, 0. 14, 0. 18, 0. 25, 0. 35, 0. 50. 0.70, 0.95,1, 25, 1.S5, 1,90,2. 25, 2. 75,  0 710 

8 3.25,3.75,4.20,4.60,5.00,5.35,5.65,5.95,6.26,6.53,6.78,7.01,7.19,  0 720 

9 7.35,7.50,  0 730 

S 0.11,0.14,0.18,0.25,0.35,0.50,0.77,1.10,1.50,1.85,2.25,2.75,3.25,  0 740 

S 3.80,4.30.4.75,5.20.5.55.5.85,6,13,6.40,6.74,7.03.7.29,7,54,7.74,  0 750 

S 7,91,8.07  / 0 760 

0  770 

0*7*  A(1),*(2),A(3>,A(4),A(5),*(6),A<7),*(8),A(9),A(10),A(11>,  0 780 

1 A(12) ,A(13) ,A(14) ,A(15) ,A(16)/0. 5, 0.52, 0.54,0. 56, 0.57, 0.58, 0.585,  0 790 

2 0.59,0,595,0.598,0.6,0.6,0.6,0.6,0,6,0.6/  0 800 

0  810 

DATA  *1/  0. 32, 0. 36, 0. 40, 0.44, 0.47, 0.5, 0.52, 0.54,0. 56, O.S7,0, 58,  0 820 

1 0.585, 0.59,0. 595,0. 598, 0.6, 0.6,0. 6,0, 6,0. 6, 0.6,0. 6, 0.6, 0,6,0. 6,  0 830 

2 0.6, 0,6, 0.6  / 0 840 

0  850 

DATA  B(1),B(2),B(3),B(4),B(5),B(6),B(7),B(8),B(9),B(10),B(11),  0 860 

1 B ( 1 2 > , B ( 1 3 ) ,0(14) , B ( 1 5 ) ,B(16)/8 1.5, 83, 5, 85. 2, 86 .9, 88.2,89.4,90. 4,  0 870 

2 91.2,91.8,92.1,92.2,92,2,92.1,92.0,91,9,91.6/  0 880 

0  890 

DATA  Bl/  70. 5, 73. 5, 75. 5, 78. 0,79. 9, 81. 5*83. 1,84. 6,86. 2, 87, 7, 89.0,  0 900 

1 90.0,90.7,91.3,91.8,92.1,92.1,92.0,91,9,91.7,91.4,90.8,90.3,  0 910 

2 89.7,89.2,88.6,88.1,87,5  / 0 920 

0  930 

DATA  C(l),C(2),C(3),C(4)«C(5),C(6),C(7)«C(6),C(9),C(lO),C(ll),  0 940 

1 C(12) ,C(13) ,C(14) ,C(15) ,C(16)/0. 75, 0,75, 0,75, 1.1, 1.0,1. 0,1. 0,1.1,  0 950 

2 0.75, 0.5, 0.3, 0.1, 0.0, -0.2, -0.4, -0.5/  0 960 

0  970 

DATA  Cl/  7. 0,5. 0,4. 0,3. 0,3. 0,2. 3,1. 5,1, 0,1, 0,1. 2, 1,2,1, 0,0. 9,0, 7,  0 980 
) 0 ,6 , 0 , 3, 0 . 1 , 0 , 0 ,— 0 , 15,  — 0 .25,— 0 ,4,— 0 ,4,—0 .5,— 0 .55,— 0.6,— 0 ,65,  0 990 

2 -0.7, -0.7  / 01000 

01010 

DATA  D(1),D(2)«0(3)«D(4), 0(5), D(6)«D(7),D(8),D(9),D(10), 0(11),  01020 

1 0(12) ,0(13) ,0(14) ,D(1S) ,0 (16) /93. 2, 95. 3, 97, 0,98. 4, 99.4, 100,1.  01030 

2 100. 7, 100. 9, 100.9, 100. 8, 100.6, 100.1, 99, 5, 98. 7, 97 .8, 86, 9/  01040 

01050 

DATA  01/  82. 0,84. 4, 86. 6, 88. 8, 91. 0,93. 1,95. 2,97. 0,98. 3, 99, 4,100.1,  01060 

1 100. 6, 101.0, 101. 1,101.0, 100. 6,1 00. 0,99. 3, 98. 5,97. 6,96, 6, 95. 8,  01070 

2 94.9,94.0,93.0,92.0,91.0,90.0  / 01080 

01090 

DATA  E(l) ,E(2) ,E(3),E(4) ,E<5) ,E(6) ,E (7) »E (8) ,E (9) ,E(10> ,E(11) , 01100 

1 E (12) ,E(13) • E ( 1 4 ) , E ( 1 5 ) ,E(16)/0. 8, 0.77, 0,75. 0.7,0, 68, 0.66, 0.63,  01 110 

2 0.6, 0.6,0. 6, 0.6, 0.6,0. 6, 0.6, 0.6, 0.6/  01120 

01130 

DATA  El/  1.0, 1.0, 1.0, 1.0, 1,0, 1.0, 1.0, 1.0, 0.9, 0,8*0, 73,0. 68, 0.65,  01140 
1 0.63, 0.6, 0,6, 0.6, 0.6, 0.6, 0,6, 0,6, 0,6, 0,6, 0,6, 0,6,0, 6, 0,6, 0,6  / 01150 

01160 

data  F(i),r(2),r(3),r(4),r(5),r(6),r(7),P(8),r(9>,r(io),r(in,  oiito 


r 


c 

c 

c 

c 


1 F 1 12) ,F ( 13) ,F<14) * F (15) ,F < 16) /2. 3, 2. 0(1. 5, 1,3, 1.0, 0.8,0. 6, 0.5, 

2 0.3,0. 1 ,«0. 15,«0«2(-0.35,«0.4,«0.4,»0(A/ 

DATA  FI/  15. 0,10. 0,10. 0,7, 5,6. 0,4. 5,3. 0,1, 7, 1.3, 1.0,0, 8,0. 6,0. 3, 

1 0.2»0.0»»0.15»-0,2»-0,3*-0 i3i*0>4i*Ol<,i*OtSi*Oi5SiaO«iiaOii2i 

2 •0.62,-0,65,<»0,7  / 

OATA  H(l)iH|2l ,H (3) »H (4) ,H (5) ,H<6) ,H <7) /0.0,0. 1 ,0.2,0.3,0.4,0 .5, 

1 0.6/ 

DATA  P ( 1 ) ,P(2).P(3) ,P<4) ,P(5) ,P(6> ,P (7) /I ,0.0 .59,0.4,0.28.0,2, 

1 0.158(0.128/ 

DATA  R/  0. 58. 0. 65. 0.7A, 0.82.0. 9, 0.95. 0(99d. Oil. 0. 1.0 d.O • 1.0 .1.0. 
1 1.0. 1.0. 1.0  / 

DATA  R1  / 0. 32(0. 36(0. A, 0.A6.0. 52, 0.S8(0,65(0.7A, 0.82(0. 90.0. 96. 

1 1. 0.1. 0.1. 0.1. 0.1. 0.1. 0.1. 0.1. 0.1. O.l.O.l. 0.1. 0.1. 0(1.0. 1.0. 

2 1.0, 1.0  / 

DATA  U ( 1 ) ,U(2) (U ( 3) ,U(A) ,U(5) ,U(6) *U (7) (U<8) ,U(9) ,U(10> (U(ll) . 

1 U(12) (U(13) ,U(1A) ,U(15) ,U(16) ,U(17) ,U(18) ,U(19) ,U(20) ,U(21)  , 

2 U(22) , U ( 23) ,U (24) /0.99, 0.98199, 0.968865, 0.9A81 ,0.91859, 0.877A1 , 

3 0.82377, 0.757455,0. 67936, 0.67, 0.66295, 0.6, 0.591905, 0,5, 0.408098, 

A 0.3206435, 0.2A25A8S, 0. 1762325, 0.1 225905, 0.081A09.0.0S1S41, 

5 0.0311374,0.018008(0.01/ 

END 


01180 

01190 

01200 

01210 

01220 

01230 

01240 

01250 

01260 

01270 

01280 

01290 

01300 

01310 

01320 

01330 

01340 

01350 

01360 

01370 

01380 

01390 

01400 

01410 

01420 

01430 

01440 

01450* 
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•DECK  SANOlsE 

SUBROUTINE  SANOISE  (BETA.TJTO.ROD.BC.Df T.AO.NFREO.FREO.I t J.TM.LO.M  P 10 

1J.0F,W0RK2,NS.SPLC,HXX.HYY.CYY*A3,A2>  P 20 

DIMENSION  TM(20>.FREO(20)tSPLC(30).HVM30).HVY(30)tCVX(30),  P 30 

l CVY (30 ) « ANS30B (30 ) P A0 

COMMON  / THIRTY  / HX(20)  P 50 

COMMON  / FORTY  / hY(20)  P 60 

COMMON  / FIFTY  / CX<20>  P 70 

COMMON  / SIXTY  / C* (20)  P 80 

REAL  MJ.K0.K1.L0.l1.WC  P 90 

IF  (J.NE.l.OR.I.NE.l)  60  TO  50  P 100 

P 110 

CALCULATION  OF  OASPLC  (PACKAGE  C)  P 120 

P 130 

IF  (BETA. GT. 1.0)  GO  TO  20  P 140 

IF  (TJTO.LT. 0.9)  Go  TO  10  P 150 

ANS10B-(40.0*ALOG10(8ETA) )-(20.0*ALOGl0(ROO) ) P 160 

OASPLC* 157, 5* ANSI OB  P 170 

GO  TO  40  P 180 

10  ANS1DB*(40.0*ALOG10(BETA) )-(20.0*ALOGl0(ROO) ) p 190 

OASPLC* 155. 5* ANSI OB  P 200 

GO  TO  40  P 210 

20  IF  ITJT0.LT. 0.9)  Go  TO  30  P 220 

ANS10B*(20.0*ALOG10(BETA) )-(20.0*ALOGlO(ROD) ) P 230 

OASPLC*157.5*ANSIDB  P 240 

GO  TO  40  P 250 

30  ANS1DB*(10.0*ALOG10(BETA))-(20.0*ALOG10(ROD>>  P 260 

OASPLC*155.S*ANS10B  P 270 

GO  TO  40  P 280 

40  CONTINUE  P 290 

50  IF  (J.NE.l)  GO  TO  70  P 300 

P 310 

CALCULATION  OF  ANS30B  AND  INTERPOLATED  VALUES  OF  HO  AND  Cl  P 320 

FOR  ALL  SPECIFIED  FREQUENCIES  (PACKAGE  C)  P 330 

P 340 

W0RK1=(  |4.?<n2*C!C*nFT*BtTA)/An)  p 350 

HVX(I>*( (6.2S3*FREO(I)*L0)/(12.0*A0) ) P 360 

CVX ( I ) *HVX ( I ) p 370 

IF  (HVX(I) .LT.0.2)  GO  TO  60  P 380 

IF  (HVX(I) .GT.70,0)  GO  TO  60  p 390 

CALL  LAGRNG  (HX,HY,20.HVX(I) .HVY(I) ) P 400S 

IF  (TJT0.LT. 0.9)  HvY(I)*HVY(I)-2.0  P 410 

CALL  LAGRNG  (CX,CY,20.CVX(I) .CVY(I) ) P 420S 

ANS30B(I)*10.0*ALOG10(WORK1*FREO(I) ) p 430 

60  CONTINUE  p 440 

70  CONTINUE  P 450 

IF  (MJ.LE.1.0)  GO  TO  110  P 460 

P 470 

SHOCK  NOISE  CONTRIBUTION  CAN  BE  ANO  IS  NEGLECTED  P 480 

FOR  THE  FOLLOWING  CONDITIONS  P P 490 

(1)  TJT 0 LESS  THAN  0.9  AND  TM(J)  LESS  THAN  50  DEG,  P 500 

(2)  TJTO  GREATER  THAN  0,9  AND  TM(J>  LESS  THAN  30  OEG.  P 510 

P 520 

IF  (TJTO.LT.0.9.AND.TM(j) ,LT. 50.0, OR. TJTO.GE. 0.9. AND. TM(J),LT, 30,0  P 530 

1)  GO  TO  120  P 540 

C P 550 

IF  (HVX(I). LT.0.2)  GO  TO  100  P 560 

IF  (HVX(I). GT.70,0)  GO  TO  100  P 570 

C P 580 


VC*6.2»3*FRE0(I) 

IIEND-NS-1 

SUMI«0,0 

00  90  II-1.IIEN0 

CI2-CVY 

ISENO*NS-I! 

SUMS*0*0 

DO  SO  ISN-ItlSEND 
IS-ISN-l 

QIS*WORK2*II«<1.0-<0.06*(IS*(<II*1.0>/2.0))n 

OCOS*COS(OI$»WC> 

QSIN*SIN((QIS»WC*BC>/2.0> 

WORKS* ( 0C0S*QS1N) /OI S 
SUMS* SUMS* WORK 3 
•0  CONTINUE 

W0RK4*CI2*SUMS 
SUMI*SUMI*W0RK4 
90  CONTINUE 
C 

W0RK5* (4 . 0*SUMI ) / ( NS*0C*WC ) 

ANS2*1.0*WORK5 

ANS2DB* 1 0 . 0*ALOG1 0 < ABS  < ANS2 ) ) 

C 

SPL*MVY ( I ) ♦ ANS10B*ANS3DB ( I ) ♦ ANS2DB 

SPLC(I)*SPL 

MXX*HVX ( I ) 

HVY*HVY ( I ) 

CYY*CVY ( I ) 

A3*ANS30B ( I ) 

A2-ANS20B 
GO  TO  130 
C 

C FAILURE  CODE  STATEMENTS  (PACKAGE  C) 

C 

100  MVY«0.0 
HXXaHVX ( I ) 

CYY»0,0 
A 3*0.0 
A2-0.0 
SPLC(I>*2.0 
GO  TO  130 

c 

110  HXX*0.0 
MYY*0.0 
CYY*0.0 
A 3*0.0 
A2-0.0 
SPLC(I)*1.0 
GO  TO  130 
C 

120  HXX*0.0 
MYY*0.0 
CVY*0,0 
A 3*0.0 
A2*0.0 
SPLC(I)*3.0 
GO  TO  130 
130  RETURN 
ENO 


P S90 
P 600 
P 610 
P 620 
P 630 
P 640 
P 650 
P 660 
P 6T0 
P 680 
P 690 
P TOO 
P T10 
P T20 
P T30 

P T40  ► 

P T50 
P T60 
P TTO 
P TBO 
P TOO 
P 800 
P 810 
P 820 
P 830 
P 840 
P 850 
P 860 
P 8T0 
P 880 
P 890 


P 920 
P 930 
P 940 
P 950 
P 960 
P 9T0 
P 980 
P 990 
P1000 
P1010 
P1020 
P1030 
P1040 
P1050 
P1060 
P10T0 
P1080 
P1090 
P1100 
Pino 
PI  120 
P1130 
P1140 
P1150 
P1160 
P11T0- 


ooooooooo 


•deck  lagpng 


SUBROUTINE  LAGRNG  (X.Y.N.VALX.VALY) 

0 

10 

0 

20 

this  SUBROUTINE  CONDUCTS  LAGRANGIAN 

0 

30 

0 

40 

X»X-COORDl NATES  Of  HO  OR  Cl 

MASTER 

INPUT 

SPECTRUM 

0 

50 

Y-Y-COORDINATES  OF  HO  OR  Cl 

MASTER 

INPUT 

SPECTRUM 

0 

60 

N-NUHBER  OF  POINTS  DESCRIBING  HO 

OR 

Cl 

master  input  spectrum 

0 

70 

VALX-ARGUMENT  SIGMA 

0 

80 

VALY» INTERPOLATED  V*LUE  OF 

HO  OR 

Cl 

AT 

argument  sigma 

0 

90 

0 

100 

DIMENSION  X (20) * Y (20) 

0 

no 

0 

120 

N1»N-1 

0 

130 

DO  10  I-2.N1 

0 

140 

IF  (VALX.LE.X(I) ) GO  TO  20 

0 

150 

CONTINUE 

0 

160 

I«N1 

0 

170 

IS1*I-1 

0 

180 

I S2» I ♦ 1 

0 

190 

valy«o.o 

0 

200 

DO  40  I - 1 SI , I S2 

0 

210 

P-l.O 

Q 

220 

DO  30  J*IS1,IS2 

0 

230 

IF  (I.EO.J)  GO  TO  30 

0 

240 

A«(VALX-X(J) )/(X(J)-X(J) ) 

0 

250 

P«P»A 

0 

260 

CONTINUE 

0 

270 

B»P*Y(I) 

0 

280 

valy»valy*b 

0 

290 

CONTINUE 

0 

300 

RETURN 

0 

310 

END 

0 

320- 

uu uuuu uu 


•deck  blksan 

BLOCK  OAT*  SAN  R 10 

R 20 

INPUT  0ATA*«**«  R 30 

R *0 

HXbARGUMCNT  SIGMA  IN  SOURCE  STRENGTH  SPECTRUM  R 50 

HYaSOURCE  STRENGTH  HO (SIGMA)  FOR  ARGUMENT  SIGMA  R 60 

CX-ARGUMENT  SIGMA  IN  CORRELATION  COEFFICIENT  SPECTRUM  R TO 

CY»CORRELATION  COEFFICIENT  Cl (SIGMA)  FOR  ARGUMENT  SIGMA  R 80 

R 90 

C0MM0N/THIRTY/HXI26)  R 100 

COMMON/FORTY/HY (20)  R 110 

COMMON/F I FTY/CX ( 20 ) R 120 

COMMON/SI  XT Y/CY (20)  R 130 

C R 1*0 

DATA  HX/  0,2*0. 3,0, *,0.7*1. 0,1. 5»2. 0»3.0,3.5»*,0.*.5«5.0,6. 0.7, 0«  R 150 

1 8,0*10, 0,20,0, *0,0*69,0*70,0  / R 160 

C R 170 

DATA  HY/  11*1. >1,121.6, 125, 5*132. 3, 137. 7, 1*2. 7, 1*5, 7, 1*8. 5, 1*9.1,  R 180 

1 1*9. 2, 1*9.1, !**.(■ ■. 1*7. w, 1*6. 7. 1*5. 7, 1*3. 7, 137. *,,130. 5, 125,*.  R 190 

2 12b.?  / R 200 

C R 210 

DATA  CX/  0. 2*0, 3*0, *, 0.7*1. 0*1. 5*2. 0*3. 0*3. 5**. 0**. 5*5. 0,6. 0*7.0*  R 220 

1 8. 0*10. 0,20. 0**0, 0*68. 0*70.0  / R 230 

C R 2*0 

DATA  CY/  r . 7il  , 0 . 71 ,0.71 ,0.7?, A. 7 3,0. 7**0. 7* ,0.71, 0.69,0. 67*0. 6*.  R 250 

1 0.t>2.0.bb,r..b*,ii.50,i.  .*5,0.2l,o.l?,n.02.0.0?  / R 260 

C R 270 

END  R 280- 
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•DECK  INTEG 

PROGRAM  INTEG ( I NPUT • OUTPUT • TAPE5» INPUT • TAPE6»0UTPUT ) 
EXTERNAL  FCT.FCD.rOA6 


real 

11 

,12. 

K 

S 

30 

real 

MJ 

s 

40 

DIMENSION  W ( 24 ) «FrE0(24) .till (24) ,WI2<24) ,XU(24) , XX (211 .ENT1 (21) , 

s 

50 

1 

ENT2 (21 ) ,DBU(24) ,DBD (24) ,08(24) 

s 

60 

2 

» SN  ( 24 ) , SP|M  (24)  ,IL(3) 

s 

70 

COMMON/CON/ 

AO. VJ.XC.K.Al ,B1 .Cl «A2.B2>C2,D2,A3.B3«RJ,WP, 

s 

80 

1 A4,A5,XLIMIT,INTFlG 

s 

90 

PI«3. 

141593 

s 

100 

s 

110 

READ 

INPUT  CONSTANTS 

s 

120 

s 

130 

READ 

(5, 

140) 

RUNNO 

s 

140* 

READ 

(5, 

170) 

(FREQ ( I ) tl»1.24> 

s 

150* 

10  READ 

(5, 

140) 

TP 

s 

160* 

IF  (TP.LT.l. 

0)  GO  TO  130 

s 

170 

REAO 

(5, 

180) 

(SPLM(I) , I«1 .24) 

s 

180* 

READ 

(5, 

160) 

I OUT 

s 

190* 

REAO 

(5, 

160) 

INTFLg 

s 

200* 

READ 

(5, 

140) 

MJ 

s 

210* 

READ 

(5, 

140) 

VJF 

s 

220* 

READ 

(5, 

140) 

XC 

s 

230* 

READ 

(5. 

140) 

TOF 

s 

240* 

READ 

(5. 

150) 

K 

s 

250* 

REAO 

(5, 

140) 

A 1 

s 

260* 

READ 

(5, 

140) 

81 

s 

270* 

READ 

(5. 

140) 

Cl 

s 

280* 

READ 

(5, 

150) 

A2 

s 

290* 

REAO 

(5. 

150) 

82 

s 

300* 

READ 

(5, 

140) 

C2 

s 

310* 

REAO 

(5, 

150) 

02 

s 

320* 

READ 

(5, 

150) 

A3 

s 

330* 

REAO 

(5, 

150) 

83 

s 

340* 

READ 

(5, 

150) 

A4 

s 

350* 

READ 

(5, 

150) 

A5 

s 

360* 

READ 

(5, 

150) 

xlimit 

s 

370* 

READ 

(5, 

140) 

RJ 

s 

380* 

READ 

(5, 

140) 

R 

s 

390* 

READ 

(5. 

150) 

PAMB 

s 

400* 

A0F»49,02*SQRT (T0F.459.67) 

PAMB«PAMB*6894. 757? 

V J»VJF* 1 2. 0 

AJ-VJ/MJ 

AO*AOF*12.0 

XC»XC*2.0*RJ*(4.3.I.1*MJ*MJ) 

VJAO-VJ/AO 

TJT0*(AJ/A0>**2 

TMETA«90.0 

K«K/(0.63*AJ*2.0*MJ*(1.1*0.9*MJ)  ) 

BEGIN  FREOuENCY  LOOP 

XLOWER«0.0 

XUPER2»1.0/XC 

TURB-0. 6667*0. 179*MJ**(-, 1028) 

CONST-20. 0* AL0G1 0 ( 1.4*PAMB/2, OE-5) -20, 0*ALOG10(P)*10.0»AlOG1 0<0.23 


S 410 
S 420 
S 430 
S 440 
S 450 
S 460 
S 470 
S 480 
S 490 
S 500 
S 510 
S S20 
S 530 
S 540 
S 550 
S 560 
S 570 
S 580 
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uuu 


116)*40.0*ALOG10(VJ/A0*TuR8/A0)-10,0*ALOG10(64.0»PI*SORT(PI) ) *10.0» 
2ALOG10 (2,0) 

00  80  I«l,24 
W ( 1 > ■2,0*PI*FREO ( I ) 

SN { I ) ■FREO ( 1 ) »2. 0*B J/V J 
WP»W(I> 

XMAX»5. 99402199/ (FrEQ ( I ) •*) 

IF  (INTFLG.EO.l)  GO  TO  20 
IF  (XC.LT.XMAX)  GO  TO  20 
XUPPER«XMAX 
CALL  0*6  (FQA6.I1) 

GO  TO  30 
20  XUPPE R«XC 

CALL  D0G32  (XLOWER.XUPPER. FCT, 1 1 > 

30  XU(I>«XUPPEP 

WI ] (I)«I1*W( I) ••5*| 1,0/SORT (Cl) ) 

WI1 (I)»Wll (I)»SORT (PI  1/2.0 
IF  (Nil (1) .GT.0.0)  GO  TO  AO 
DBU(I>»0.0 
GO  TO  50 

AO  D8U(I)»10.0*ALOG10(WI1 II) > 

50  CALL  OOG32  (XLOWER.XUPER2.FCO, 12) 

WI2 ( I ) *I2*W ( I ) ••S/ (2,0*C2) 

WI2(I)-Wl2(I)/4.0 
IF  (WI2(I) .GT.0.0)  GO  TO  60 
080(1 >*0,0 
GO  TO  70 

60  OBO ( I ) *10 ,0*ALOG10 ( WI2 ( I ) ) 

70  DB(I>«10.0*ALOG10(10.0*»(DBU(I>/10.0)«10.0»<M08D(I)/10.0) ) 

OBU ( I ) *DBU ( I ) ‘CONST 
080(1) -060 (II*C0NSt 

DB ( I ) «OB ( I ) *CONST 
BO  CONTINUE 

WRITE  (6« 190)  INTFlG,mj,T0F,A0»VJF,xC,HJ,A1,A2.B1,B2«C1.C2,K.02,A3 
1,B3.AA,A5,R,PAHB,XlImIT 
DO  90  I>1,2* 

WRITE  (6«200)  FREO(I) fSN(I) ,OBU(I) ,080(1) .OB(I) 

90  CONTINUE 

IF  (IOUT.EO.O)  GO  TO  120 
WRITE  (6.210) 

ENT2(1)-0.0 
00  110  1>1.2A 
WPaW(I) 

WRITE  (6.220)  FREO<I).W(D 
00  100  J"1 i21 
XX (J) "FLOAT (J«l ) 

ENT1 (J)«FCT(XX(J) )«W(I)**5»(1.0/SORT(C1) ) 

IF  (J.EO.l)  GO  TO  100 

ENT2(J)-FCO(1.0/XX(J))»W(I)*«5/(2.0»C2)/XX(J)»«2 
100  CONTINUE 

WRITE  (6.230)  XX(l).ENTKl) 

WRITE  (6.230)  (XX(j),ENTl(J).ENT2(J).Ja2.21> 

110  CONTINUE 
120  CONTINUE 

RETURN  FOR  NEXT  COMPUTATION 
GO  TO  10 


S 590 
S 600 
S 610 
S 620 
S 630 
S 640 
S 650 
S 660 
S 670 
S 6S0 
S 690S 
S 700 
S 710 
S 720* 
S 730 
S 740 
S 750 
S 760 
S 770 
S 780 
S 790 
S 800* 
S 810 
S S20 
S 830 
S 840 
S 850 
S 860 
S 870 
S 880 
S 890 
S 900 
S 910 
S 920* 
S 930 
S 940 
S 950* 
S 960 
S 970 
S 980* 
S 990 
S1000 
S1010 
S1020* 
S1030 
S1040 
SI  050 
SI  060 
SI  070 
S1080 
S1090* 
S1100* 
S1110 
SI  1 20 
SI  130 
SU40 
SI  150 
SI  160 
SI  170 


uuuu 


r 


130  STOP 

FORMAT  STATEMENTS 


140  FORMAT  (F15.1) 

150  FORMAT  (E10.4) 

160  FORMAT  (ID 
170  FORMAT  (8F10.1> 

ISO  FORMAT  (12F6.1) 

190  FORMAT  (1H1.T8. "INPUT  PARAMETERS  FOR  INTEGRATION  ARE  -"»//, T2t"INT 
1FLG  ■ '•» I2,//T5»"Mj  ■ " , E 1 5, 8 , T40  » "TO  ■ "»E15.8,//,T5,"Ao  • «,E15, 
26»T40,"VJ  ■ ",E15.B,//,T5,"XC  • ",E15.8,T40»"RJ  ■ ",E15,8,//,T5,"A 
31  ■ »,E15.8,T40,"A2  a ",E1S.8,//,T5,"B1  ■ ",E15.8,T40,"B2  m «,E15. 
48,//,T5,»Cl  « ",E15,8»T40."C2  ■ ",E15.8,//,T5,"  K a "»El5,8.T40."D 
52  ■ "»E15,8»//»T5»mA3  ■ ",E15.8,T40."B3  ■ »,E15.8, //«T$,»A4  ■ "tEl 
65,8 , T40 , »A5  « " ,E 15.8 . //, T5,"  R ■ ",E1S,8,T40."P0  ■ »,El5.8,//.T5, 
7"XLIMIT  « ", F6. 2, ////,T2, "FREQUENCY". Tl8,«SN",T29,"DBU"»f40."DBD"» 
8T51 »"DB",/) 

200  FORMAT  <T3,F8.2,T15,F7,3,3<4X,F7,2) ) 

210  FORMAT  (1H1.T24, "VALUES  OF  INTEGRAND  FOR  VARIOUS  VALUES  OF  X",/) 
220  FORMAT  </,5X. "FREQUENCY  ■ ",F8.2,5X,"0MEgA  a ", E 1 5 ,7 • /? . T15, "X" , T2 
18, "INTEGRAND  1 ", T48 , "INTEGRAND  2"./) 

230  FORMAT  ( 1 1 X ,F 1 0 .6.5X* E 15. 7.5X.E 15, 7) 

END 


SI  180 
SI  190 
S1200 
S1210 
S1220 
S1230 
S1240 
S1250 
S1260 
S1270 
S1280 
S1290 
S1300 
S1310 
S1320 
S1330 
SI  340 
S1350 
S1360 
S1370 
S1380 
S1390 
S1400 
S1410 
S1420* 


•OECK  fct 

FUNCTION  FCT(X)  T 10 

REAL  Ll.LT.K  T 20 

COMMON/CON/  A0.VJ,XC,K.Al,Bl,C1.42,B2tC2,D2,A3tB3,RJ»WP,  T 30 

1 A4, A5.XLIMIT t INTFlG  T 40 

OATA  PI.RTP  / 3.141593,0.797865  / T 50 

R12»RJ  T 60 

IF  (X.LE.XLIHIT)  GO  TO  10  T 70 

Ll«Al*X*Bl  T 80 

LT»A3«X*B3  T 90 

GO  TO  20  T 100 

io  li«aa*x  t no 

LT«A5»X  T 120 

20  CONTINUE  T 130 

Dl«i.O  T 140 

TO*K*X**Ol  T 150 

IF  ( INTFLG.EO. 1 ) GO  TO  50  T 160 

PART1«R12*X>L l*i  T**2*T0  T 170 

PARTb»(WP»TO;  8,0  T 180 

IF  (PART. LT. 147. a. AND. PART. GT, -146. 5)  60  TO  30  T 190 

PART2*0.0  T 200 

GO  TO  40  T 210 

30  PART2*EXP (PART)  T 220 

40  FCT«PART1*PART2«EXP(-.0016*X*X)  T 230 

RETURN  T 240 

50  PART1«R12»X*L1*LT»*2*T0  T 250 

PART»-(L1»WP)»«2/(8.0*P1*0.63«0,63»VJ»VJ)  T 260 

IF  (PART.LT , 147,5, ANO. PART .GT.-146.5)  GO  TO  60  T 270 

PART2-0.0  T 280 

GO  TO  70  T 290 

60  PART2«EXP(PART)  T 300 

70  P ART 3»RTP*P 1/4,0/ ( 1 . 0*  < WP*T0) **2/4,0 )••! ,5  T 310 

FCT«PART1*PART2*PART3*EXP(-.0016«X*X)  T 320 

RETURN  T 330 

END  T 340- 


•DECK  0610 

SUBROUTINE  0610  (XL.XU.FCT.Y)  U 10 

A*0.5*<XU*XL>  U 20 

B*XU-XL  U 30 

0*0.4869533*8  U 40 

Y*0« 03333567* (FCT(A*C) ♦FCT (A-C) ) U 50 

0*0.4325317*8  U 60 

Y*Y*0.07472567*(FCT(A*C) ♦FCT(A-C) ) U 70 

0*0.3397048*8  U 80 

Y*Y*0, 1095432* (FCT(A*C)*FCT (A-C) ) U 90 

0*0.2166977*8  U 100 

Y*Y*0.1346334*(FCT(A*C)*FCT(A-C>)  U 110 

0*0,07443717*8  U 120 

Y*B*  <Y«0. 1477621* (FCT ( A.C) *FCT (A-C) ) ) U 130 

RETURN  U 140 

END  U 150- 


•DECK  rOA6 

FUNCTION  FQA6(XP)  V 10 

REAL  H.LTtK  V 20 

COMMON/CON/  A0,VJ,XC.K,Al,Bl,Cl,A2.B2»C2,D2.A3tB3.RJ»*P.  V 30 

1 A4,A5«XLIMIT«INTFL6  V 40 

X»SORT(8.0»XP/(WP»*2*K**2))  V 50 

R12-RJ  V 60 

IF  (X.LE.XLIMIT)  60  TO  10  V 70 

L1>A1»X*B1  V 80 

LT»A3*X*B3  V 90 

GO  TO  20  V 100 

10  Ll-A4«X  V 110 

LT»A5«*X  V 120 

20  CONTINUE  V 130 

T0»K»X  V 140 

PARTI "SORT (XP) *R12*L1*LT#LT»T0  V 150 

PART2»(NP«*2»K*«2)/4,0  V 160 

FOA6-PAPT1/PART2«ExP(-.0016»X*X>  V 170 

RETURN  V 180 

END  V 190- 


•DECK  0*6 

SUBROUTINE  0*6  (FCT» Y) 
*■15. 12996 
y«.53lT103E-6*FCT(X) 
X»9. 12*2*8 

Y«Y*.0001714737*FCT(X> 
X»5. 196153 

Y»Y*. 007810781 *FCT (X) 
X"2. 552590 
Y"Y*.1032160*FCT(X) 

X>. 8983028 

Y*Y* .5209846*FCT (X) 

Xa, 09874701 

Y»Y*1.U0270*FCT<X) 

RETURN 

END 


W 100 

w no 

W 120 
W 130 
W 140 
w 150- 


•DECK  ECO 

FUNCTION  FCO(X)  X 10 

BEAU  L2.LT.K  X 20 

COMMON/CON/  AO,VJfXC.K,Al,Bl,Cl,A2.B2*C2,D2.A3,03,BJ»KF,  X 30 

1 A4, A5.XLIMIT,  INTF|_6  X *0 

DATA  PI.RTP  / 3,141593,0,797885  / X 50 

L2* ( A2/X*B2) ••02  X 60 

LT« (A3/X-B3) *»D2  X 70 

TO*K/X  * «0 

IF  (1NTFL6.EQ.1)  Go  TO  30  X 90 

PART1«L2*LT*LT»XC*«4*EXPI-.0016*XC*XC)#To  X 100 

PART*- (WP*T0)  ••2/8.0  X HO 

IF  (PART.LT • 147,5, aNO, PART «GT,-146,5)  GO  TO  10  X 120 

PART2*0»0  X 130 

GO  TO  20  * 1*0 

10  PAR T2»EXP (PART)  X 150 

20  FC0*PART1*PART2  X 160 

RETURN  X 170 

30  PART 1*L2*LT**2#XC**4»EXP (-.001 6*XC*XC) *T0  X 180 

VC*0,63#VJ  * l’O 

PART*-(L2*WP)»*2/(8.0*PI*VC*VC)  X 200 

IF  (PART.LT, 147,5, aN0«PART.GT,-146»5)  GO  TO  40  X 210 

PART2*0«0  X 220 

GO  TO  50  X 230 

40  PART2*EXP (PART)  X 240 

50  PART3*RTP*PI/4,0/ (1,0* (WP*T0) **2/4,0) **1  ,5  X 250 

FC0*PART1*PART2*PArT3  X 260 

RETURN  X 270 

ENO  X 280- 


•DECK  DQG32 


SUBROUTINE  00632  (XL.XU.FCT.Y) 

A*, 5* (XU*XL) 

B-XU-XL 

C*. 498631 93092474078*8 

Y*. 003509305004735048* (FCT ( A*C> *FCT ( A-C) ) 

C». 4928057557726341*8 

Y«Y*.008137197365452835*(FCT(A*C)*FCT(A-C) ) 

C*. 48238112779375322*9 

Y*Y*. 0 12696032654631030* (FCT (A*C)*FCT( A-C) > 

C*. 46745303796886984*8 

Y*Y*.  017136931456510717* (FCT (A*C)*FCT (A-C) ) 

C*. 44816057788302606*0 

Y*Y*. 02141 794901 1H3340*  (FCT (A*C)*FCT( A-C) > 

C*. 42468380686628499*0 

Y*Y* .025499029631 180008* (FCT ( A*C) *FCT (A-C) ) 

C*. 397241 69798397120*8 

Y*Y* . 029342046739267774* (FCT (A*C>  *FCT ( A-C) > 

C*. 366091 059370 14404*0 

Y*Y*. 032911 1 11388180923* (FCT ( A.C) *FCT (A-C) ) 

C*. 3315221 334651 0760*8 

Y*Y*. 036172897054424253* (FCT ( A»C ) *FCT (A-C) ) 

C*. 293857878620381 16*0 

Y*Y* ,039096947893535153* (FCT ( A*C) *FCT (A-C) ) 

C*. 2534499544661 1470*B 

Y*Y*. 041 6559621 13473378* (FCT (A*C)*FCT( A-C) ) 

C*. 21 067563806531767*8 

Y*Y* .043826046502201906* (FCT ( A*C) *FCT (*-C) ) 

C*. 165934301 141 06362*0 

Y*Y*. 045586939347881942* (FCT (A*C)*FCT( A-C) ) 

C*. 11964360112606854*8 

Y*Y*. 046922199540402283* (FCT (A*C)*FCT (A-C) ) 

C*. 07223598079139825*8 

Y*Y* ,047819360039637430* (FCT ( A*C) *FCT (A-C) ) 

C" ,024 1 53832843869 158*B 

Y*B* (Y*. 048270044257363900* (FCT ( A*C) *FCT ( A-C) ) ) 

RETURN 

END 


Y 100 

y no 

Y 120 

Y 130 

Y 140 

Y 150 

Y 160 

Y 170 

Y 180 

Y 190 

Y 200 

Y 210 

Y 220 

Y 230 

Y 240 

Y 250 

Y 260 

Y 270 

Y 200 

Y 290 

Y 300 

Y 310 

Y 320 

Y 330 

Y 340 

Y 350 

Y 360 

Y 370- 


